Paso 5 (1)- Trayectorias de hospitalización y mortalidad con foco en condiciones vinculadas a trastornos de salud mental y consumo de sustancias posterior a un primer ingreso por alguno de estos trastornos, en usuarios/as jóvenes y adultos emergentes de población general y pertenecientes a pueblos originarios, 2018-2021, Chile

Representar las mejores opciones de agrupamiento, junto con su relación con otras variables. En esta etapa, analizamos la asociación con covariables de la solución con mejores índices de calidad para la resolución trimestral.

Author

Andrés González Santa Cruz

Published

21 de Jan, 2025

Configurar

Code
# remover objetos y memoria utilizada
rm(list=ls());gc()
          used (Mb) gc trigger (Mb) max used (Mb)
Ncells  600033 32.1    1291448   69   690405 36.9
Vcells 1159091  8.9    8388608   64  1876466 14.4
Code
#remover imágenes
while(!dev.cur())dev.off()
cat("\014")
Code
if(Sys.info()["sysname"]=="Windows"){
 folder_path <- ifelse(dir.exists("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/"),
                       "H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/",
                       "C:/Users/CISS Fondecyt/Mi unidad/Alvacast/SISTRAT 2022 (github)/_proposal_grant/2023/")
} else {folder_path <- ""}
load(paste0(folder_path,"20240903.RData"))

Paquetes estadísticos

Code
#elegir repositorio
if(Sys.info()["sysname"]=="Windows"){
  options(repos = c(CRAN = "https://cran.dcc.uchile.cl/"))
}
options(install.packages.check.source = "yes") # Chequea la fuente de los paquetes

#borrar caché
#system("fc-cache -f -v")

if(!require(pacman)){install.packages("pacman");require(pacman)}

pacman::p_unlock(lib.loc = .libPaths()) #para no tener problemas reinstalando paquetes

if(Sys.info()["sysname"]=="Windows"){
if (getRversion() != "4.4.0") { stop("Requiere versión de R 4.4.0. Actual: ", getRversion()) }
}

if(!require(job)){install.packages("job");require(job)}
if(!require(kableExtra)){install.packages("kableExtra");require(kableExtra)}
if(!require(tidyverse)){install.packages("tidyverse");require(tidyverse)}
if(!require(cluster)){install.packages("cluster"); require(cluster)}
if(!require(WeightedCluster)){install.packages("WeightedCluster"); require(WeightedCluster)}
if(!require(devtools)){install.packages("devtools"); require(devtools)}
if(!require(TraMineR)){install.packages("TraMineR"); require(TraMineR)}
if(!require(TraMineRextras)){install.packages("TraMineRextras"); require(TraMineRextras)}
if(!require(NbClust)){install.packages("NbClust"); require(NbClust)}
if(!require(haven)){install.packages("haven"); require(haven)}
if(!require(ggseqplot)){install.packages("ggseqplot"); require(ggseqplot)}
if(!require(grid)){install.packages("grid"); require(grid)}
if(!require(gridExtra)){install.packages("gridExtra"); require(gridExtra)}
if(!require(Tmisc)){install.packages("Tmisc"); require(Tmisc)}
if(!require(factoextra)){install.packages("factoextra"); require(factoextra)}
if(!require(stargazer)){install.packages("stargazer"); require(stargazer)}
if(!require(gtsummary)){install.packages("gtsummary"); require(gtsummary)}
if(!require(lmtest)){install.packages("lmtest"); require(lmtest)}
if(!require(emmeans)){install.packages("emmeans"); require(emmeans)}
if(!require(fpp2)){install.packages("fpp2"); require(fpp2)}
if(!require(purrr)){install.packages("purrr"); require(purrr)}
if(!require(forecast)){install.packages("forecast"); require(forecast)}
if(!require(magrittr)){install.packages("magrittr"); require(magrittr)}
if(!require(foreach)){install.packages("foreach"); require(foreach)}
if(!require(doParallel)){install.packages("doParallel"); require(doParallel)}
if(!require(progressr)){install.packages("progressr"); require(progressr)}
if(!require(chisq.posthoc.test)){devtools::install_github("ebbertd/chisq.posthoc.test")}
if(!require(rstatix)){install.packages("rstatix"); require(rstatix)}
if(!require(rio)){install.packages("rio"); require(rio)}
if(!require(cowplot)){install.packages("cowplot"); require(cowplot)}
if(!require(DiagrammeR)){install.packages("DiagrammeR"); require(DiagrammeR)}
if(!require(DiagrammeRsvg)){install.packages("DiagrammeRsvg"); require(DiagrammeRsvg)}
if(!require(rsvg)){install.packages("rsvg"); require(rsvg)}

seq_mean_t_dos_grupos <- function(bd = NULL, group1, group2) {
  # Agrupar por ambas variables
  resultados <- by(bd, list(group1, group2), seqmeant)
  
  # Obtener todas las combinaciones posibles de los grupos
  combinaciones <- expand.grid(group1 = unique(group1), group2 = unique(group2), stringsAsFactors = FALSE)
  
  # Extraer los resultados y asociarlos con las combinaciones
  resultados_df <- do.call(rbind, lapply(seq_along(resultados), function(i) {
    group_name1 <- attr(resultados, "dimnames")[[1]][i]
    group_name2 <- attr(resultados, "dimnames")[[2]][i]
    
    data.frame(factor_inclusivo_1 = group_name1, 
               factor_inclusivo_2 = group_name2, 
               Mean = resultados[[i]])
  }))
  
  # Unir los resultados con las combinaciones para rellenar los valores faltantes
  final_df <- merge(combinaciones, resultados_df, by.x = c("group1", "group2"), 
                    by.y = c("factor_inclusivo_1", "factor_inclusivo_2"), all.x = TRUE)
  
  return(final_df)
}

multinom_pivot_wider <- function(x) {
  # check inputs match expectatations
  # create tibble of results
  df <- tibble::tibble(outcome_level = unique(x$table_body$groupname_col))
  df$tbl <- 
    purrr::map(
      df$outcome_level,
      function(lvl) {
        gtsummary::modify_table_body(
          x, 
          ~dplyr::filter(.x, .data$groupname_col %in% lvl) %>%
            dplyr::ungroup() %>%
            dplyr::select(-.data$groupname_col)
        )
      }
    )
  
  tbl_merge(df$tbl, tab_spanner = paste0("**", df$outcome_level, "**"))
}

best_subset_multinom <- function(y, x.vars, data) {
  # y       Nombre de la variable dependiente (cadena de texto)
  # x.vars  Vector de nombres de predictores (caracter)
  # data    Dataframe con los datos de entrenamiento
  
  # Cargar las librerías necesarias
  require(dplyr)
  require(purrr)
  require(tidyr)
  require(nnet)
  require(MASS)
  
  # Generar todas las combinaciones posibles de predictores
  predictors_list <- lapply(1:length(x.vars), function(i) {
    combn(x.vars, i, simplify = FALSE)
  }) %>% unlist(recursive = FALSE)
  
  # Inicializar una lista para almacenar los resultados
  results <- list()
  
  # Iterar sobre cada combinación de predictores
  for (i in seq_along(predictors_list)) {
    predictors <- predictors_list[[i]]
    formula <- as.formula(paste(y, "~", paste(predictors, collapse = "+")))
    
    # Ajustar el modelo multinomial
    model <- tryCatch(
      nnet::multinom(formula, data = data, trace = FALSE),
      error = function(e) NULL
    )
    
    # Si el modelo se ajustó correctamente, almacenar los resultados
    if (!is.null(model)) {
      # Extraer el AIC del modelo
      aic <- AIC(model)
      
      # Almacenar la información en una lista
      results[[length(results) + 1]] <- list(
        predictors = predictors,
        model = model,
        AIC = aic
      )
    }
  }
  
  # Convertir la lista de resultados en un dataframe
  results_df <- results %>%
    purrr::map_df(function(res) {
      data.frame(
        predictors = paste(res$predictors, collapse = "+"),
        AIC = res$AIC,
        stringsAsFactors = FALSE
      )
    })
  
  # Ordenar los modelos por AIC de menor a mayor
  results_df <- results_df %>% arrange(AIC)
  
  return(results_df)
}
best_subset_multinom_interactions <- function(y, x.vars, data) {
  # y       Nombre de la variable dependiente (cadena de texto)
  # x.vars  Vector de nombres de predictores (caracter)
  # data    Dataframe con los datos de entrenamiento
  
  # Cargar las librerías necesarias
  require(dplyr)
  require(purrr)
  require(tidyr)
  require(nnet)
  require(MASS)
  
  # Generar todas las combinaciones posibles de predictores (efectos principales)
  main_effects_list <- lapply(1:length(x.vars), function(i) {
    combn(x.vars, i, simplify = FALSE)
  }) %>% unlist(recursive = FALSE)
  
  # Inicializar una lista para almacenar los resultados
  results <- list()
  
  # Iterar sobre cada combinación de efectos principales
  for (main_effects in main_effects_list) {
    
    # Generar términos de interacción de hasta 3 variables
    interaction_terms <- list()
    
    # Para interacciones de 2 variables
    if (length(main_effects) >= 2) {
      interaction_terms_2way <- combn(main_effects, 2, function(x) paste(x, collapse = ":"))
      interaction_terms <- c(interaction_terms, interaction_terms_2way)
    }
    
    # Para interacciones de 3 variables
    if (length(main_effects) >= 3) {
      interaction_terms_3way <- combn(main_effects, 3, function(x) paste(x, collapse = ":"))
      interaction_terms <- c(interaction_terms, interaction_terms_3way)
    }
    
    # Combinar efectos principales e interacciones
    all_terms <- c(main_effects, interaction_terms)
    
    # Generar todas las combinaciones posibles de términos (incluyendo interacciones)
    # Solo se incluyen interacciones si sus efectos principales están presentes
    term_combinations <- list()
    
    # Obtener todos los subconjuntos de efectos principales
    main_effects_subsets <- lapply(1:length(main_effects), function(i) {
      combn(main_effects, i, simplify = FALSE)
    }) %>% unlist(recursive = FALSE)
    
    # Para cada subconjunto de efectos principales
    for (me in main_effects_subsets) {
      # Iniciar con los efectos principales
      terms <- me
      
      # Incluir interacciones solo si todos sus efectos principales están incluidos
      possible_interactions <- interaction_terms[
        sapply(interaction_terms, function(x) {
          vars_in_interaction <- unlist(strsplit(x, ":"))
          all(vars_in_interaction %in% me)
        })
      ]
      
      # Generar todas las combinaciones de interacciones para incluir
      interaction_subsets <- list(NULL)
      if (length(possible_interactions) > 0) {
        interaction_subsets <- lapply(1:length(possible_interactions), function(i) {
          combn(possible_interactions, i, simplify = FALSE)
        }) %>% unlist(recursive = FALSE)
      }
      
      # Para cada combinación de interacciones, crear el conjunto completo de términos
      for (ints in interaction_subsets) {
        if (is.null(ints)) {
          full_terms <- terms
        } else {
          full_terms <- c(terms, ints)
        }
        
        # Añadir a la lista de combinaciones de términos
        term_combinations <- append(term_combinations, list(full_terms))
      }
    }
    
    # Ajustar modelos para cada combinación de términos
    for (terms in term_combinations) {
      formula <- as.formula(paste(y, "~", paste(terms, collapse = "+")))
      
      # Ajustar el modelo multinomial
      model <- tryCatch(
        nnet::multinom(formula, data = data, trace = FALSE),
        error = function(e) NULL,
        warning = function(w) NULL
      )
      
      # Si el modelo se ajustó correctamente, almacenar los resultados
      if (!is.null(model)) {
        # Extraer el BIC del modelo
        bic <- BIC(model)
        
        # Almacenar la información en la lista de resultados
        results[[length(results) + 1]] <- list(
          predictors = paste(terms, collapse = " + "),
          model = model,
          BIC = bic
        )
      }
    }
  }
  
  # Convertir la lista de resultados en un dataframe
  results_df <- results %>%
    purrr::map_df(function(res) {
      data.frame(
        predictors = res$predictors,
        BIC = res$BIC,
        stringsAsFactors = FALSE
      )
    })
  
  # Ordenar los modelos por BIC de menor a mayor
  results_df <- results_df %>% arrange(BIC)
  
  return(results_df)
}

best_subset_multinom_interactions_parallel <- function(y, x.vars, data) {
  # y       Nombre de la variable dependiente (cadena de texto)
  # x.vars  Vector de nombres de predictores (caracter)
  # data    Dataframe con los datos de entrenamiento
  
  # Cargar las librerías necesarias dentro de la función
  require(dplyr)
  require(purrr)
  require(tidyr)
  require(nnet)
  require(MASS)
  require(foreach)
  require(doParallel)
  require(progressr)
  
  # Iniciar los gestores de progreso
  handlers(global = TRUE)
  handlers("txt")
  
  # Generar todas las combinaciones posibles de predictores (efectos principales)
  main_effects_list <- lapply(1:length(x.vars), function(i) {
    combn(x.vars, i, simplify = FALSE)
  }) %>% unlist(recursive = FALSE)
  
  # Inicializar una lista para almacenar las fórmulas de los modelos
  formulas_list <- list()
  
  # Generar todas las fórmulas posibles con interacciones hasta de 3 variables
  for (main_effects in main_effects_list) {
    
    # Generar términos de interacción de hasta 3 variables
    interaction_terms <- character(0)  # Aseguramos que es un vector de caracteres
    
    # Para interacciones de 2 variables
    if (length(main_effects) >= 2) {
      interaction_terms_2way <- combn(main_effects, 2, function(x) paste(x, collapse = ":"), simplify = TRUE)
      interaction_terms <- c(interaction_terms, interaction_terms_2way)
    }
    
    # Para interacciones de 3 variables
    if (length(main_effects) >= 3) {
      interaction_terms_3way <- combn(main_effects, 3, function(x) paste(x, collapse = ":"), simplify = TRUE)
      interaction_terms <- c(interaction_terms, interaction_terms_3way)
    }
    
    # Generar todas las combinaciones posibles de efectos principales
    main_effects_subsets <- lapply(1:length(main_effects), function(i) {
      combn(main_effects, i, simplify = FALSE)
    }) %>% unlist(recursive = FALSE)
    
    # Para cada subconjunto de efectos principales
    for (me in main_effects_subsets) {
      # Iniciar con los efectos principales
      terms <- me
      
      # Identificar interacciones cuyos efectos principales están en 'me'
      if (length(interaction_terms) > 0) {
        possible_interactions <- interaction_terms[
          vapply(interaction_terms, function(x) {
            vars_in_interaction <- unlist(strsplit(x, ":"))
            all(vars_in_interaction %in% me)
          }, FUN.VALUE = logical(1))
        ]
      } else {
        possible_interactions <- character(0)
      }
      
      # Generar todas las combinaciones posibles de estas interacciones
      interaction_subsets <- list(character(0))  # Incluir el caso sin interacciones
      if (length(possible_interactions) > 0) {
        interaction_combinations <- lapply(1:length(possible_interactions), function(i) {
          combn(possible_interactions, i, simplify = FALSE)
        }) %>% unlist(recursive = FALSE)
        interaction_subsets <- c(interaction_subsets, interaction_combinations)
      }
      
      # Para cada combinación de interacciones
      for (ints in interaction_subsets) {
        full_terms <- c(terms, ints)
        
        # Crear la fórmula del modelo y almacenarla
        formula_str <- paste(y, "~", paste(full_terms, collapse = "+"))
        formulas_list <- append(formulas_list, list(formula_str))
      }
    }
  }
  
  # Eliminar posibles duplicados de fórmulas
  formulas_list <- unique(formulas_list)
  
  # Total de modelos a ajustar
  total_models <- length(formulas_list)
  
  # Iniciar el progreso
  p <- progressor(steps = total_models)
  
  # Ajustar los modelos en paralelo usando foreach
  results_list <- foreach(i = 1:total_models, .packages = c("nnet", "MASS"), .combine = 'rbind') %dopar% {
    formula_str <- formulas_list[[i]]
    formula <- as.formula(formula_str)
    
    # Ajustar el modelo
    model <- tryCatch(
      nnet::multinom(formula, data = data, trace = FALSE),
      error = function(e) NULL,
      warning = function(w) NULL
    )
    
    # Actualizar el progreso
    p(sprintf("Ajustando modelo %d de %d", i, total_models))
    
    # Si el modelo se ajustó correctamente, almacenar los resultados
    if (!is.null(model)) {
      bic <- BIC(model)
      data.frame(
        predictors = formula_str,
        BIC = bic,
        stringsAsFactors = FALSE
      )
    } else {
      NULL
    }
  }
  
  # Convertir los resultados a dataframe y ordenar por BIC
  results_df <- as.data.frame(results_list)
  results_df <- results_df %>% arrange(BIC)
  
  return(results_df)
}


num_cores <- parallel::detectCores() - 1
cl <- makeCluster(num_cores)
registerDoParallel(cl)

#pacman job kableExtra tidyverse cluster WeightedCluster devtools TraMineR TraMineRextras NbClust haven ggseqplot gridExtra Tmisc factoextra reticulate withr rmarkdown quarto

options(knitr.kable.NA = '')


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#

knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      # record the current time before each chunk
      now <<- Sys.time()
    } else {
      # calculate the time difference after a chunk
      res <- ifelse(difftime(Sys.time(), now)>(60^2),difftime(Sys.time(), now)/(60^2),difftime(Sys.time(), now)/(60^1))
      # return a character string to show the time
      x<-ifelse(difftime(Sys.time(), now)>(60^2),paste("Tiempo que demora esta sección:", round(res,1), "horas"),paste("Tiempo que demora esta sección:", round(res,1), "minutos"))
      paste('<div class="message">', gsub('##', '\n', x),'</div>', sep = '\n')
    }
  }
}))
knitr::opts_chunk$set(time_it = TRUE)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

format_cells <- function(df, rows ,cols, value = c("italics", "bold", "strikethrough")){
  
  # select the correct markup
  # one * for italics, two ** for bold
  map <- setNames(c("*", "**", "~~"), c("italics", "bold", "strikethrough"))
  markup <- map[value]  
  
  for (r in rows){
    for(c in cols){
      
      # Make sure values are not factors
      df[[c]] <- as.character( df[[c]])
      
      # Update formatting
      df[r, c] <- ifelse(nchar(df[r, c])==0,"",paste0(markup, gsub(" ", "", df[r, c]), markup))
    }
  }
  
  return(df)
}
#To produce line breaks in messages and warnings
knitr::knit_hooks$set(
  error = function(x, options) {
    paste('\n\n<div class="alert alert-danger">',
          gsub('##', '\n', gsub('^##\ Error', '**Error**', x)),
          '</div>', sep = '\n')
  },
  warning = function(x, options) {
    paste('\n\n<div class="alert alert-warning">',
          gsub('##', '\n', gsub('^##\ Warning:', '**Warning**', x)),
          '</div>', sep = '\n')
  },
  message = function(x, options) {
    paste('<div class="message">',
          gsub('##', '\n', x),
          '</div>', sep = '\n')
  }
)

#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Function to format CreateTableOne into a database")

as.data.frame.TableOne <- function(x, ...) {capture.output(print(x,showAllLevels = TRUE, varLabels = T,...) -> x)
  y <- as.data.frame(x)
  y$characteristic <- dplyr::na_if(rownames(x), "")
  y <- y %>%
    fill(characteristic, .direction = "down") %>%
    dplyr::select(characteristic, everything())
  rownames(y) <- NULL
  y}
#_#_#_#_#_#_#_#_#_#_#_#_#_
# Austin, P. C. (2009). The Relative Ability of Different Propensity 
# Score Methods to Balance Measured Covariates Between 
# Treated and Untreated Subjects in Observational Studies. Medical 
# Decision Making. https://doi.org/10.1177/0272989X09341755
smd_bin <- function(x,y){
  z <- x*(1-x)
  t <- y*(1-y)
  k <- sum(z,t)
  l <- k/2
  
  return((x-y)/sqrt(l))
  
}

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:


if(.Platform$OS.type == "windows") withAutoprint({
  memory.size()
  memory.size(TRUE)
  memory.limit()
})
> memory.size()
[1] Inf
> memory.size(TRUE)
[1] Inf
> memory.limit()
[1] Inf
Code
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
func_tab_range_clus<-
function(range_clus){
rbind.data.frame(
  lapply(
    list(
      as.vector(rev(sort(table(range_clus$clustering$cluster2)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster3)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster4)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster5)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster6)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster7)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster8)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster9)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster10)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster11)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster12)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster13)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster14)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster15))))
    ),
    function(x) {
      length_out <- max(sapply(list(
        as.vector(rev(sort(table(range_clus$clustering$cluster2)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster3)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster4)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster5)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster6)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster7)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster8)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster9)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster10)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster11)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster12)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster13)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster14)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster15))))
      ), length))
      c(x, rep(NA, length_out - length(x)))
    }
  )
)%>%
  t() |> 
  data.frame()%>%
  `rownames<-`(NULL)
}


frobenius_norm <- function(matrix1, matrix2) {
    if (!all(dim(matrix1) == dim(matrix2))) {
        stop("Matrices must have the same dimensions")
    }
    
    # Replace NA values with 0 (or any other desired default)
    matrix1[is.na(matrix1)] <- 0
    matrix2[is.na(matrix2)] <- 0
    
    # Calculate the residuals
    residuals <- matrix1 - matrix2
    
    # Frobenius norm
    frobenius <- sqrt(sum(residuals^2))
    return(frobenius)
}



#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
confcqi2 <- function(nullstat, quant, n){
  alpha <- (1-quant)/2
  #calpha <- alpha+(alpha-1)/n
  #print(c(calpha, alpha))
  #minmax <- quantile(nullstat, c(calpha, 1-calpha))
  minmax <- quantile(nullstat, c(alpha, 1-alpha))
  return(minmax)
}

normstatcqi2 <- function(bcq, stat, norm=TRUE){
  origstat <- bcq$clustrange$stats[, stat]
  nullstat <- bcq$stats[[stat]]
  #normstat <- rbind(nullstat, origstat)
  if(norm){
    for(i in seq_along(origstat)){
      mx <- mean(nullstat[, i])
      sdx <- sd(nullstat[, i])
      nullstat[ , i] <- (nullstat[, i]-mx)/sdx
      origstat[i] <- (origstat[i]-mx)/sdx
    }
  }
  alldatamax <- apply(nullstat, 1, max)#as.vector(xx)
  sumcqi <- list(origstat=origstat, nullstat=nullstat, alldatamax=alldatamax)
  return(sumcqi)
}
print.seqnullcqi.powder <- function(x, norm = FALSE, quant = 0.95, digits = 2, 
                                    append = FALSE, ...) {
    cat("Parametric bootstrap cluster analysis validation\n")
    cat("Sequence analysis null model:", deparse(x$nullmodel), "\n")
    cat("Number of bootstraps:", x$R, "\n")
    cat("Clustering method:", ifelse(x$kmedoid, "PAM/K-Medoid", paste0("hclust with ", x$hclust.method)), "\n")
    cat("Seqdist arguments:", deparse(x$seqdist.args), "\n\n\n")
    alls <- as.data.frame(x$clustrange$stats)
    quants <- rep("", ncol(alls))
    names(quants) <- colnames(alls)
    for (ss in colnames(alls)) {
        sumcqi <- normstatcqi2(x, stat = ss, norm = norm)
        alls[, ss] <- as.character(round(sumcqi$origstat, digits = digits))
        borne <- as.character(round(confcqi2(sumcqi$alldatamax, quant, x$R), digits = digits))
        quants[ss] <- paste0("[", borne[1], "; ", borne[2], "]")
    }
    results_tibble <- tibble::as_tibble(rbind(alls, rep("", length(quants)), quants))
    # Print a summary to the console for immediate feedback
    rownames(results_tibble) <- c(rownames(x$clustrange$stats), "", paste("Null Max-T", quant, "interval"))
    
    results_df <- as.data.frame(results_tibble)
    print(results_tibble, ...)
    return(list(
      results_tibble= results_tibble, 
      results_df= results_df
      ))
}

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
##:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
# Función para aplicar la prueba de Fisher a todas las combinaciones de filas usando todas las columnas
fisher_posthoc_all_cols <- function(contingency_table) {
  # Obtener combinaciones de filas (pares)
  row_pairs <- combn(rownames(contingency_table), 2, simplify = FALSE)
  
  # Aplicar la prueba de Fisher a cada par de filas usando todas las columnas al mismo tiempo
  results <- map_dfr(row_pairs, function(pair) {
    # Crear tabla de 2xN para el par de filas en todas las columnas
    sub_table <- contingency_table[pair, , drop = FALSE]
    
    # Aplicar el test de Fisher
    test_result <- fisher.test(sub_table, 
                                 simulate.p.value=T,
                                 B=1e4)
    
    # Devolver los resultados en un data frame
    tibble(
      Row1 = pair[1],
      Row2 = pair[2],
      p.value = test_result$p.value
    )
  })
  
  # Ajustar p-valores usando el método de Holm
  results <- results %>%
    mutate(p.adjusted = p.adjust(p.value, method = "holm"))
  
  return(results)
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
save_base_plot_as_grob <- function(plot_expr, res=300,  width = 1600, height= 1200) {
    # Crea un archivo temporal con extensión .png
    filename <- tempfile(fileext = ".png")
    
    # Guarda el gráfico en alta resolución en el archivo temporal
    png(filename, width = width, height = height, res = res)
    replayPlot(plot_expr)  # Reproduce el gráfico grabado
    dev.off()  # Cierra el dispositivo gráfico
    
    # Convierte el archivo PNG en un objeto gráfico (grob)
    grob <- grid::rasterGrob(png::readPNG(filename), interpolate = TRUE)
    
    return(grob)  # Devuelve el grob
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
chisq_cramerv<- function(contingency_table){
  chisq_test <- chisq.test(contingency_table)
  cramers_v <- sqrt(chisq_test$statistic / (sum(contingency_table) * (min(dim(contingency_table)) - 1)))
  
  list(chisq_statistic= sprintf("%1.2f", chisq_test$statistic), chisq_df= chisq_test$parameter, chisq_p_value = ifelse(chisq_test$p.value<.001, "<0.001", sprintf("%1.4f", chisq_test$p.value)), cramers_v = sprintf("%1.2f", cramers_v))
}

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#
oneway_anova_effect_size <- function(values, group) {
  # Perform one-way ANOVA
  anova_result <- aov(values ~ group)
  
  # Summarize ANOVA results
  anova_summary <- summary(anova_result)
  
  # Extract sums of squares
  ss_between <- anova_summary[[1]]$"Sum Sq"[1]
  ss_total <- sum(anova_summary[[1]]$"Sum Sq")
  
  # Calculate eta-squared
  eta_squared <- ss_between / ss_total
  
  # Return ANOVA summary and effect size
  list(
    anova_summary = anova_summary,
    eta_squared = eta_squared
  )
}

Resultados

0.a. Historial

A continuación, mostramos un ejemplo para utilizar el algoritmo LCS (Longest common subsequence o Subsecuencia común más larga).

Code
invisible("Soluciones de cluster seleccionadas")
# States_Wide.seq_quarter_t_prim_adm_cens, 
# group=om_dist_quarter_c$clustering$cluster9, 
# 
# 
# tates_Wide.seq_quarter_t_prim_adm_cens, 
# group=om_dist_quarter_c$clustering$cluster6 # 2do lugar
# 
# States_Wide.seq_quarter_t_prim_adm_cens, 
# group=pamRange_quarter_om$clustering$cluster6
# 
# 
# States_Wide.seq_month_t_prim_adm_cens, 
# group=lcs_dist_month_c$clustering$cluster4 #
# 
# 
# States_Wide.seq_quarter_t_prim_adm_cens, 
# group=lcs_dist_quarter_c_rm$clustering$cluster5
# 
# 
# pamRange_quarter_om$clustering$cluster6
# 
# States_Wide.seq_quarter_t_prim_adm_RM
# 
invisible("Bases sobre las que utilizar")

#dt_ing_calendar_quarter_t_desde_primera_adm_dedup
#
#dt_ing_calendar_month_t_desde_primera_adm_dedup
#


# Definir las cadenas ficticias
cadena_A <- c("cp", "aus", "aus", "psi", "psi", "cens")
cadena_B <- c("cp", "aus", "psi", "psi", "psi", "aus")

# Longitudes de las cadenas
n <- length(cadena_A)
m <- length(cadena_B)

# Crear la matriz LCS
LCS <- matrix(0, nrow = n + 1, ncol = m + 1)

# Llenar la matriz según el algoritmo LCS
for (i in 2:(n + 1)) {
  for (j in 2:(m + 1)) {
    if (cadena_A[i - 1] == cadena_B[j - 1]) {
      LCS[i, j] <- LCS[i - 1, j - 1] + 1
    } else {
      LCS[i, j] <- max(LCS[i - 1, j], LCS[i, j - 1])
    }
  }
}

# Convertir la matriz a un data frame para ggplot
LCS_df <- as.data.frame(LCS) %>%
  mutate(row = 0:n) %>%
  pivot_longer(-row, names_to = "col", values_to = "value") %>%
  mutate(col = as.integer(gsub("V", "", col)) - 1)

# Etiquetas para las cadenas
labels_A <- c("", cadena_A)
labels_B <- c("", cadena_B)

# Graficar con ggplot
ggplot(LCS_df, aes(x = col, y = row, fill = value)) +
  geom_tile(color = "white") +
  geom_text(aes(label = value), color = "black", size = 6) +
  scale_fill_gradient(low = "white", high = "blue") +
  scale_x_continuous(breaks = 0:m, labels = labels_B) +
  scale_y_reverse(breaks = 0:n, labels = labels_A) +
  labs(title = "Matriz de LCS para cadenas ['cp', 'aus', 'aus', 'psi', 'psi', 'cens'] y\n ['cp', 'aus', 'psi', 'psi', 'psi', 'aus']",
       fill = "Subsecuencia\ncomún más\nlarga",
       x = "Cadena B",
       y = "Cadena A") +
  theme_minimal()+
  theme(
    plot.title = element_text(size = 20, face = "bold"),
    axis.title = element_text(size = 16),
    axis.text = element_text(size = 14),
    legend.title = element_text(size = 14),
    legend.text = element_text(size = 12)
  )
Ejemplo LCS

Ejemplo LCS

Tiempo que demora esta sección: 0 minutos

De igual forma, intentamos graficar

Code
import numpy as np
import matplotlib.pyplot as plt
from sklearn.metrics import pairwise_distances
from sklearn.cluster import KMeans
import seaborn as sns
from matplotlib.patches import Ellipse

# Generar datos artificiales bien centrados
np.random.seed(42)
cluster_1 = np.random.normal(loc=0, scale=0.5, size=(30, 2))
cluster_2 = np.random.normal(loc=5, scale=0.5, size=(30, 2))
cluster_3 = np.random.normal(loc=10, scale=0.5, size=(30, 2))
data = np.vstack([cluster_1, cluster_2, cluster_3])

# Aplicar K-Means con k=3 para obtener las etiquetas (usamos K-Means solo para obtener etiquetas iniciales)
kmeans = KMeans(n_clusters=3, random_state=42).fit(data)
labels = kmeans.labels_

# Calcular los medoides manualmente
medoids = []
for i in np.unique(labels):
    cluster_points = data[labels == i]
    distances = pairwise_distances(cluster_points, metric='euclidean')
    medoid_index = np.argmin(distances.sum(axis=0))
    medoids.append(cluster_points[medoid_index])

medoids = np.array(medoids)

# Crear el gráfico
plt.figure(figsize=(8, 6))
sns.scatterplot(x=data[:, 0], y=data[:, 1], hue=labels, palette="viridis", style=labels, legend=None)
plt.scatter(medoids[:, 0], medoids[:, 1], color='red', s=200, marker='*', label='Medoid')

# Añadir las elipses alrededor de cada cluster (simplificadas)
for i in np.unique(labels):
    cluster_points = data[labels == i]
    mean_x, mean_y = np.mean(cluster_points, axis=0)
    cov_matrix = np.cov(cluster_points.T)
    width = 2 * np.std(cluster_points[:, 0])
    height = 2 * np.std(cluster_points[:, 1])
    ellipse = Ellipse((mean_x, mean_y), width, height, edgecolor='black', facecolor='none', linewidth=2, linestyle='--')
    plt.gca().add_patch(ellipse)

plt.title("Clusters con Medoides Destacados y Elipses Simplificadas")
plt.xlabel("X")
plt.ylabel("Y")
plt.legend()

# Guardar el gráfico en un archivo PNG
plt.savefig("_figs/clusters_kmedoids.png", format="png", dpi=300, bbox_inches='tight')

# Mostrar el gráfico
plt.show()
Ejemplo LCS

Ejemplo LCS

Tiempo que demora esta sección: 0.1 minutos

Code
set.seed(324) # Setting seed for reproducibility # Slice specific rows, random selection with seed, and select columns "0" to "19" 
result_df_trim <- ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% slice_sample(n = 4) %>% # Randomly select 4 rows 
  select("0":"19") # Select columns "0" to "19" (assuming they are in positions 1 to 20)

Tiempo que demora esta sección: 0 minutos

0.b. Descripción tiempo seguimiento

Describir censura incluyendo muerte.

Code
dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time_rec<- ifelse(!is.na(dt_df_filled_quarter_t_desde_primera_adm_expand$death_time)&dt_df_filled_quarter_t_desde_primera_adm_expand$death_time<dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time,
                     dt_df_filled_quarter_t_desde_primera_adm_expand$death_time,
                     dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time)

psych::describe(dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time_rec) %>% 
  knitr::kable("html")
vars n mean sd median trimmed mad min max range skew kurtosis se
X1 1 12371 17.85584 1.757469 18.00448 17.97795 1.412609 0.0109516 19.98672 19.97577 -4.397878 33.47011 0.015801

Tiempo que demora esta sección: 0 minutos

Ahora por mes

Code
dt_df_filled_month_t_desde_primera_adm_expand$cens_time_rec<- ifelse(!is.na(dt_df_filled_month_t_desde_primera_adm_expand$death_time)&dt_df_filled_month_t_desde_primera_adm_expand$death_time<dt_df_filled_month_t_desde_primera_adm_expand$cens_time,
                     dt_df_filled_month_t_desde_primera_adm_expand$death_time,
                     dt_df_filled_month_t_desde_primera_adm_expand$cens_time)

psych::describe(dt_df_filled_month_t_desde_primera_adm_expand$cens_time_rec) %>% 
  knitr::kable("html")
vars n mean sd median trimmed mad min max range skew kurtosis se
X1 1 14925 53.63163 5.28762 54.14485 54.0116 4.189116 0.0328549 59.96016 59.92731 -4.455774 33.91993 0.0432816

Tiempo que demora esta sección: 0 minutos

0.c. Compilación de todos CQI’s

Code
graph <-
  grViz("
digraph combinatoria {
  graph [rankdir=LR]  // Configuración vertical

  node [shape = rectangle, style = filled, color = lightblue]

  Inicio [style = invisible]  // Nodo Inicio invisible
  Inicio -> {\"HAC\" \"PAM\" \"PAM2\"} [style = invisible, arrowhead = none]  // Flechas iniciales invisibles

  \"HAC\" -> {\"HAC-OM\" \"HAC-LCS\"}
  \"PAM\" -> {\"PAM-OM\" \"PAM-LCS\"}

  \"HAC-OM\" -> {\"HAC-OM-Trimestral\" \"HAC-OM-Mensual\"}
  \"HAC-LCS\" -> {\"HAC-LCS-Trimestral\" \"HAC-LCS-Mensual\"}
  \"PAM-OM\" -> {\"PAM-OM-Trimestral\" \"PAM-OM-Mensual\"}
  \"PAM-LCS\" -> {\"PAM-LCS-Trimestral\" \"PAM-LCS-Mensual\"}
  
  \"PAM2\" -> {\"PAM2-OM\" \"PAM2-LCS\"}

  \"PAM2-OM\" -> {\"PAM2-OM-Trimestral\" \"PAM2-OM-Mensual\"}
  \"PAM2-LCS\" -> {\"PAM2-LCS-Trimestral\" \"PAM2-LCS-Mensual\"}  
}
")
graph

Diagrama de algoritmos y métodos de agrupamiento utilizados

Code
# Exportar a SVG
svg_code <- export_svg(graph)
writeLines(svg_code, "_figs/diagrama_hierarquia.svg")
svg_code <- export_svg(graph)
rsvg_png(charToRaw(svg_code), file = "_figs/diagrama_hierarquia.png")

Tiempo que demora esta sección: 0 minutos

0.c.1. Trimestral

Code

pamRange_quarter_om2 <- wcKMedRange(dist_quarter_om, kvals=2:15,  initialclust = om_dist_quarter)
pamRange_quarter_lcs2 <- wcKMedRange(dist_quarter_lcs, kvals=2:15,  initialclust = lcs_dist_quarter)

as2 <- new.env()
load("_perm/bah.RData", envir = as2)

as <- new.env()
options(width = 1e4) #para ampliar la vista del capture output
load("_perm/null_ssa_om_quarter_null_comb_20240905.Rda", envir = as)
hac_om_quarter_null_comb_stats<-as$om_quarter_null_comb$stats
hac_om_quarter_null_comb_print<-print.seqnullcqi.powder(as$om_quarter_null_comb)
plot(as$om_quarter_null_comb, "ASW")
hac_om_quarter_null_comb_plot_asw <- recordPlot()
plot(as$om_quarter_null_comb, "ASW", type="density")
hac_om_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(as$om_quarter_null_comb, "HC")
hac_om_quarter_null_comb_plot_hc <- recordPlot()
plot(as$om_quarter_null_comb, "HC", type="density")
hac_om_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(as$om_quarter_null_comb, "HG")
hac_om_quarter_null_comb_plot_hg <- recordPlot()
plot(as$om_quarter_null_comb, "HG", type="density")
hac_om_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(as$om_quarter_null_comb, "PBC")
hac_om_quarter_null_comb_plot_pbc <- recordPlot()
plot(as$om_quarter_null_comb, "PBC", type="density")
hac_om_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(om_quarter_null_comb, envir = as)

load("_perm/null_ssa_om_quarter_null_seq_20240905.Rda", envir = as)
hac_om_quarter_null_seq_stats<-as$om_quarter_null_seq$stats
hac_om_quarter_null_seq_print<-print.seqnullcqi.powder(as$om_quarter_null_seq)
plot(as$om_quarter_null_seq, "ASW")
hac_om_quarter_null_seq_plot_asw <- recordPlot()
plot(as$om_quarter_null_seq, "HC")
hac_om_quarter_null_seq_plot_hc <- recordPlot()
plot(as$om_quarter_null_seq, "HG")
hac_om_quarter_null_seq_plot_hg <- recordPlot()
plot(as$om_quarter_null_seq, "PBC")
hac_om_quarter_null_seq_plot_pbc <- recordPlot()

plot(as$om_quarter_null_seq, "ASW", type="density")
hac_om_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(as$om_quarter_null_seq, "HC", type="density")
hac_om_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(as$om_quarter_null_seq, "HG", type="density")
hac_om_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(as$om_quarter_null_seq, "PBC", type="density")
hac_om_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(om_quarter_null_seq, envir = as)

load("_perm/null_ssa_lcs_quarter_null_comb_20240905.Rda", envir = as)
hac_lcs_quarter_null_comb_stats<-as$lcs_quarter_null_comb$stats
hac_lcs_quarter_null_comb_print<-print.seqnullcqi.powder(as$lcs_quarter_null_comb)
plot(as$lcs_quarter_null_comb, "ASW")
hac_lcs_quarter_null_comb_plot_asw <- recordPlot()
plot(as$lcs_quarter_null_comb, "HC")
hac_lcs_quarter_null_comb_plot_hc <- recordPlot()
plot(as$lcs_quarter_null_comb, "HG")
hac_lcs_quarter_null_comb_plot_hg <- recordPlot()
plot(as$lcs_quarter_null_comb, "PBC")
hac_lcs_quarter_null_comb_plot_pbc <- recordPlot()

plot(as$lcs_quarter_null_comb, "ASW", type="density")
hac_lcs_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(as$lcs_quarter_null_comb, "HC", type="density")
hac_lcs_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(as$lcs_quarter_null_comb, "HG", type="density")
hac_lcs_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(as$lcs_quarter_null_comb, "PBC", type="density")
hac_lcs_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(lcs_quarter_null_comb, envir = as)

load("_perm/null_ssa_lcs_quarter_null_seq_20240905.Rda", envir = as)
hac_lcs_quarter_null_seq_stats<-as$lcs_quarter_null_seq$stats
hac_lcs_quarter_null_seq_print<-print.seqnullcqi.powder(as$lcs_quarter_null_seq)
plot(as$lcs_quarter_null_seq, "ASW")
hac_lcs_quarter_null_seq_plot_asw <- recordPlot()
plot(as$lcs_quarter_null_seq, "HC")
hac_lcs_quarter_null_seq_plot_hc <- recordPlot()
plot(as$lcs_quarter_null_seq, "HG")
hac_lcs_quarter_null_seq_plot_hg <- recordPlot()
plot(as$lcs_quarter_null_seq, "PBC")
hac_lcs_quarter_null_seq_plot_pbc <- recordPlot()

plot(as$lcs_quarter_null_seq, "ASW", type="density")
hac_lcs_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(as$lcs_quarter_null_seq, "HC", type="density")
hac_lcs_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(as$lcs_quarter_null_seq, "HG", type="density")
hac_lcs_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(as$lcs_quarter_null_seq, "PBC", type="density")
hac_lcs_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(lcs_quarter_null_seq, envir = as)

tryCatch({
  load("_perm/null_ssa_pam_quarter_om_comb_20241226.Rda", envir = as)
}, error = function(e) {
  # Handle the error if loading fails
  message(paste("Error loading file:", e$message))
  as$pam_om_quarter_null_comb<- as2$pam_om_quarter_null_comb
})
pam_om_quarter_null_comb_stats<-as$pam_om_quarter_null_comb$stats
pam_om_quarter_null_comb_print<-print.seqnullcqi.powder(as$pam_om_quarter_null_comb)
plot(as$pam_om_quarter_null_comb, "ASW")
pam_om_quarter_null_comb_plot_asw <- recordPlot()
plot(as$pam_om_quarter_null_comb, "HC")
pam_om_quarter_null_comb_plot_hc <- recordPlot()
plot(as$pam_om_quarter_null_comb, "HG")
pam_om_quarter_null_comb_plot_hg <- recordPlot()
plot(as$pam_om_quarter_null_comb, "PBC")
pam_om_quarter_null_comb_plot_pbc <- recordPlot()

plot(as$pam_om_quarter_null_comb, "ASW", type="density")
pam_om_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(as$pam_om_quarter_null_comb, "HC", type="density")
pam_om_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(as$pam_om_quarter_null_comb, "HG", type="density")
pam_om_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(as$pam_om_quarter_null_comb, "PBC", type="density")
pam_om_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_comb, envir = as)
invisible("no funciona: nul incrustado en la cadena")
#https://stackoverflow.com/questions/45489737/getting-embedded-nul-in-string-in-an-rdata-file-is-the-rdata-file-format-po

load("_perm/null_ssa_pam_quarter_om_seq_20241221.Rda", envir = as)
pam_om_quarter_null_seq_stats<-as$pam_om_quarter_null_seq$stats
pam_om_quarter_null_seq_print<-print.seqnullcqi.powder(as$pam_om_quarter_null_seq)
plot(as$pam_om_quarter_null_seq, "ASW")
pam_om_quarter_null_seq_plot_asw <- recordPlot()
plot(as$pam_om_quarter_null_seq, "HC")
pam_om_quarter_null_seq_plot_hc <- recordPlot()
plot(as$pam_om_quarter_null_seq, "HG")
pam_om_quarter_null_seq_plot_hg <- recordPlot()
plot(as$pam_om_quarter_null_seq, "PBC")
pam_om_quarter_null_seq_plot_pbc <- recordPlot()

plot(as$pam_om_quarter_null_seq, "ASW", type="density")
pam_om_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(as$pam_om_quarter_null_seq, "HC", type="density")
pam_om_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(as$pam_om_quarter_null_seq, "HG", type="density")
pam_om_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(as$pam_om_quarter_null_seq, "PBC", type="density")
pam_om_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_seq, envir = as)

tryCatch({
  load("_perm/null_ssa_pam_quarter_lcs_comb_20241221.Rda", envir = as)
}, error = function(e) {
  # Handle the error if loading fails
  message(paste("Error loading file:", e$message))
  as$pam_lcs_quarter_null_comb<- as2$pam_lcs_quarter_null_comb
})
pam_lcs_quarter_null_comb_stats<-as$pam_lcs_quarter_null_comb$stats
pam_lcs_quarter_null_comb_print<-print.seqnullcqi.powder(as$pam_lcs_quarter_null_comb)
plot(as$pam_lcs_quarter_null_comb, "ASW")
pam_lcs_quarter_null_comb_plot_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_comb, "HC")
pam_lcs_quarter_null_comb_plot_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_comb, "HG")
pam_lcs_quarter_null_comb_plot_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_comb, "PBC")
pam_lcs_quarter_null_comb_plot_pbc <- recordPlot()

plot(as$pam_lcs_quarter_null_comb, "ASW", type="density")
pam_lcs_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_comb, "HC", type="density")
pam_lcs_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_comb, "HG", type="density")
pam_lcs_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_comb, "PBC", type="density")
pam_lcs_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_comb, envir = as)
invisible("no funciona: nul incrustado en la cadena")

load("_perm/null_ssa_pam_quarter_lcs_seq_20241221.Rda", envir = as)
pam_lcs_quarter_null_seq_stats<-as$pam_lcs_quarter_null_seq$stats
pam_lcs_quarter_null_seq_print<-print.seqnullcqi.powder(as$pam_lcs_quarter_null_seq)
plot(as$pam_lcs_quarter_null_seq, "ASW")
pam_lcs_quarter_null_seq_plot_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_seq, "HC")
pam_lcs_quarter_null_seq_plot_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_seq, "HG")
pam_lcs_quarter_null_seq_plot_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_seq, "PBC")
pam_lcs_quarter_null_seq_plot_pbc <- recordPlot()

plot(as$pam_lcs_quarter_null_seq, "ASW", type="density")
pam_lcs_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_seq, "HC", type="density")
pam_lcs_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_seq, "HG", type="density")
pam_lcs_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_seq, "PBC", type="density")
pam_lcs_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_seq, envir = as)


load("_perm/null_ssa_pam_om_quarter_null_comb2_20241221.Rda", envir = as)
pam_om_quarter_null_comb2_stats<-as$pam_om_quarter_null_comb2$stats
pam_om_quarter_null_comb2_print<-print.seqnullcqi.powder(as$pam_om_quarter_null_comb2)
plot(as$pam_om_quarter_null_comb2, "ASW")
pam_om_quarter_null_comb2_plot_asw <- recordPlot()
plot(as$pam_om_quarter_null_comb2, "HC")
pam_om_quarter_null_comb2_plot_hc <- recordPlot()
plot(as$pam_om_quarter_null_comb2, "HG")
pam_om_quarter_null_comb2_plot_hg <- recordPlot()
plot(as$pam_om_quarter_null_comb2, "PBC")
pam_om_quarter_null_comb2_plot_pbc <- recordPlot()

plot(as$pam_om_quarter_null_comb2, "ASW", type="density")
pam_om_quarter_null_comb2_plot_dens_asw <- recordPlot()
plot(as$pam_om_quarter_null_comb2, "HC", type="density")
pam_om_quarter_null_comb2_plot_dens_hc <- recordPlot()
plot(as$pam_om_quarter_null_comb2, "HG", type="density")
pam_om_quarter_null_comb2_plot_dens_hg <- recordPlot()
plot(as$pam_om_quarter_null_comb2, "PBC", type="density")
pam_om_quarter_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_comb2, envir = as)

load("_perm/null_ssa_pam_om_quarter_null_seq2_20241221.Rda", envir = as)
pam_om_quarter_null_seq2_stats<-as$pam_om_quarter_null_seq2$stats
pam_om_quarter_null_seq2_print<-print.seqnullcqi.powder(as$pam_om_quarter_null_seq2)
plot(as$pam_om_quarter_null_seq2, "ASW")
pam_om_quarter_null_seq2_plot_asw <- recordPlot()
plot(as$pam_om_quarter_null_seq2, "HC")
pam_om_quarter_null_seq2_plot_hc <- recordPlot()
plot(as$pam_om_quarter_null_seq2, "HG")
pam_om_quarter_null_seq2_plot_hg <- recordPlot()
plot(as$pam_om_quarter_null_seq2, "PBC")
pam_om_quarter_null_seq2_plot_pbc <- recordPlot()

plot(as$pam_om_quarter_null_seq2, "ASW", type="density")
pam_om_quarter_null_seq2_plot_dens_asw <- recordPlot()
plot(as$pam_om_quarter_null_seq2, "HC", type="density")
pam_om_quarter_null_seq2_plot_dens_hc <- recordPlot()
plot(as$pam_om_quarter_null_seq2, "HG", type="density")
pam_om_quarter_null_seq2_plot_dens_hg <- recordPlot()
plot(as$pam_om_quarter_null_seq2, "PBC", type="density")
pam_om_quarter_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_seq2, envir = as)

load("_perm/null_ssa_pam_quarter_lcs_comb2_20241221.Rda", envir = as)
pam_lcs_quarter_null_comb2_stats<-as$pam_lcs_quarter_null_comb2$stats
pam_lcs_quarter_null_comb2_print<-print.seqnullcqi.powder(as$pam_lcs_quarter_null_comb2)
plot(as$pam_lcs_quarter_null_comb2, "ASW")
pam_lcs_quarter_null_comb2_plot_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_comb2, "HC")
pam_lcs_quarter_null_comb2_plot_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_comb2, "HG")
pam_lcs_quarter_null_comb2_plot_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_comb2, "PBC")
pam_lcs_quarter_null_comb2_plot_pbc <- recordPlot()

plot(as$pam_lcs_quarter_null_comb2, "ASW", type="density")
pam_lcs_quarter_null_comb2_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_comb2, "HC", type="density")
pam_lcs_quarter_null_comb2_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_comb2, "HG", type="density")
pam_lcs_quarter_null_comb2_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_comb2, "PBC", type="density")
pam_lcs_quarter_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_comb2, envir = as)

load("_perm/null_ssa_pam_quarter_lcs_seq2_20241221.Rda", envir = as)
pam_lcs_quarter_null_seq2_stats<-as$pam_lcs_quarter_null_seq2$stats
pam_lcs_quarter_null_seq2_print<-print.seqnullcqi.powder(as$pam_lcs_quarter_null_seq2)
plot(as$pam_lcs_quarter_null_seq2, "ASW")
pam_lcs_quarter_null_seq2_plot_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_seq2, "HC")
pam_lcs_quarter_null_seq2_plot_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_seq2, "HG")
pam_lcs_quarter_null_seq2_plot_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_seq2, "PBC")
pam_lcs_quarter_null_seq2_plot_pbc <- recordPlot()

plot(as$pam_lcs_quarter_null_seq2, "ASW", type="density")
pam_lcs_quarter_null_seq2_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_quarter_null_seq2, "HC", type="density")
pam_lcs_quarter_null_seq2_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_quarter_null_seq2, "HG", type="density")
pam_lcs_quarter_null_seq2_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_quarter_null_seq2, "PBC", type="density")
pam_lcs_quarter_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_seq2, envir = as)

options(width = getOption("width"))

rm(as2)

Tiempo que demora esta sección: 0.1 minutos

Code
invisible("Me faltan 4: los de PAM con comb y seq para om y lcs (om2 y lcs2)")
cqi_quarter<-
rbind.data.frame(
cbind.data.frame(algo="hac", type="om", time="quarter", k=2:15, corr=F, om_dist_quarter_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="hac", type="lcs", time="quarter", k=2:15, corr=F, lcs_dist_quarter_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="quarter", k=2:15, corr=F, pamRange_quarter_om$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="quarter", k=2:15, corr=T, pamRange_quarter_om2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="quarter", k=2:15, corr=F, pamRange_quarter_lcs$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="quarter", k=2:15, corr=T, pamRange_quarter_lcs2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2)))
)|> 
  dplyr::select(algo, type, time, k, corr, PBC, ASW, HC, HG, R2, R2sq)
# round(summary(silhouette(as.integer(om_dist_quarter_c$clustering$cluster2), as.dist(dist_quarter_om)))$clus.avg.widths,2)[attr(rev(sort(table(om_dist_quarter_c$clustering$cluster2))),"names")]

#functión para generar el gráfico
tabs_quarter_clus_sol<-
rbind.data.frame(
func_tab_range_clus(om_dist_quarter_c),
func_tab_range_clus(lcs_dist_quarter_c),
func_tab_range_clus(pamRange_quarter_om),
func_tab_range_clus(pamRange_quarter_om2),
func_tab_range_clus(pamRange_quarter_lcs),
func_tab_range_clus(pamRange_quarter_lcs2)
)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
##:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

# Inicializamos una lista para almacenar los resultados
resultados_list <- list()
# Definimos un rango para los clusters a evaluar
cluster_range <- 2:15
# Definimos los métodos y sus variables
metodos <- list(
    hac_om = list(data = om_dist_quarter_c, dist = dist_quarter_om),
    hac_lcs = list(data = lcs_dist_quarter_c, dist = dist_quarter_lcs),
    pam_om0 = list(data = pamRange_quarter_om, dist = dist_quarter_om),
    pam_om1 = list(data = pamRange_quarter_om2, dist = dist_quarter_om),
    pam_lcs0 = list(data = pamRange_quarter_lcs, dist = dist_quarter_lcs),
    pam_lcs1 = list(data = pamRange_quarter_lcs2, dist = dist_quarter_lcs)
)
# Número máximo de clusters para definir las columnas
max_clusters <- max(cluster_range)
# Iteramos sobre cada método
for (metodo in names(metodos)) {
    # Creamos un data frame temporal para cada método
    metodo_result <- data.frame()
    # Iteramos sobre cada cluster en el rango
    for (cluster in cluster_range) {
        # Construimos el nombre del cluster dinámicamente
        cluster_name <- paste0("cluster", cluster)
        # Intentamos calcular los valores de silhouette
        silhouette_values <- tryCatch(
            round(summary(silhouette(as.integer(metodos[[metodo]]$data$clustering[[cluster_name]]), as.dist(metodos[[metodo]]$dist)))$clus.avg.widths[attr(rev(sort(table(metodos[[metodo]]$data$clustering[[cluster_name]]))),"names")], 2),
            error = function(e) rep(NA, cluster)
        )
        # Creamos un vector con las columnas llenando con NA si faltan valores
        silhouette_full <- c(silhouette_values, rep(NA, max_clusters - length(silhouette_values)))
        # Creamos un data frame temporal con los resultados para este cluster
        cluster_result <- data.frame(
            Metodo = metodo,
            Cluster = cluster,
            t(silhouette_full) # Transponemos los valores para que cada uno sea una columna
        )
        # Nombramos dinámicamente las columnas de silhouette
        colnames(cluster_result)[3:(3 + max_clusters - 1)] <- paste0("asw", 1:max_clusters)
        # Añadimos el resultado del cluster al data frame del método
        metodo_result <- rbind(metodo_result, cluster_result)
    }
    # Agregamos los resultados del método a la lista general
    resultados_list[[metodo]] <- metodo_result
}
# Combinamos todos los resultados en un único data frame
avs_por_cluster_quarter <- do.call(rbind, resultados_list)
# Ordenamos por Método y Cluster
avs_por_cluster_quarter <- avs_por_cluster_quarter[order(avs_por_cluster_quarter$Metodo, avs_por_cluster_quarter$Cluster), ]

bind_cols(cqi_quarter, tabs_quarter_clus_sol)%>%
  dplyr::mutate(corr= dplyr::case_when(corr==TRUE & algo!="hac"~"1",corr==FALSE & algo!="hac"~"0",T~""), key= paste0(algo,"_",type,corr,"_",k))|> 
  left_join(dplyr::mutate(avs_por_cluster_quarter, key=paste0(Metodo,"_",Cluster)), by="key") |> 
  dplyr::select(-Metodo, -Cluster) |> 
            `rownames<-`(NULL) %>%
  dplyr::mutate(calc= round(PBC*(1/HC)*HG,2)) %>% 
  dplyr::arrange(desc(ASW)) %>%
  dplyr::select(c("algo", "type", "time", "k", "corr", "PBC", "ASW", "HC", "HG", "R2", "R2sq", "calc", paste0("X",1:15), paste0("asw",1:15))) %>% 
  {
    assign("asw_quarter_qci", dplyr::select(., -"time"), envir = .GlobalEnv)
    .
  } %>% 
    { 
        rio::export(., "_output/sol_conglomerados_tab_quarter.xlsx")            
        knitr::kable(., "markdown", caption = "CQIs y frecuencias en conglomerados (trimestre)")
    }
CQIs y frecuencias en conglomerados (trimestre)
algo type time k corr PBC ASW HC HG R2 R2sq calc X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 asw1 asw2 asw3 asw4 asw5 asw6 asw7 asw8 asw9 asw10 asw11 asw12 asw13 asw14 asw15
hac lcs quarter 2 0.61 0.70 0.11 0.94 0.10 0.23 5.21 5737 301 0.74 -0.06
pam om quarter 7 0 0.60 0.61 0.09 0.79 0.41 0.52 5.27 4372 680 313 205 189 142 137 0.70 0.64 0.21 0.52 0.06 -0.08 0.14
pam om quarter 13 0 0.61 0.61 0.06 0.86 0.50 0.59 8.74 3909 680 232 203 151 136 130 113 110 99 95 93 87 0.75 0.61 0.27 0.50 0.16 -0.13 0.08 0.33 -0.05 0.33 0.31 0.26 0.32
pam om quarter 14 0 0.61 0.61 0.05 0.87 0.51 0.60 10.61 3837 680 232 203 151 136 130 113 108 97 92 92 87 80 0.76 0.60 0.25 0.49 0.15 -0.14 0.07 0.32 -0.04 0.35 0.33 0.27 0.32 0.30
pam om quarter 15 0 0.61 0.61 0.05 0.86 0.52 0.60 10.49 3781 680 232 203 151 136 130 113 106 95 87 87 85 81 71 0.76 0.60 0.24 0.49 0.14 -0.14 0.06 0.31 -0.04 0.36 0.32 0.42 0.38 0.30 0.50
pam om quarter 4 0 0.50 0.60 0.18 0.67 0.31 0.39 1.86 4788 684 354 212 0.64 0.64 0.09 0.49
pam om quarter 5 0 0.57 0.60 0.13 0.74 0.36 0.47 3.24 4674 680 321 207 156 0.64 0.65 0.23 0.51 -0.05
pam om quarter 6 0 0.59 0.60 0.10 0.78 0.39 0.50 4.60 4476 680 319 207 202 154 0.68 0.64 0.22 0.50 0.02 -0.06
pam om quarter 12 0 0.61 0.60 0.07 0.85 0.49 0.58 7.41 3988 680 232 204 152 136 130 113 111 106 99 87 0.72 0.61 0.28 0.50 0.16 -0.13 0.09 0.35 -0.04 0.25 0.36 0.32
pam om quarter 4 1 0.50 0.60 0.18 0.67 0.31 0.39 1.86 4788 684 354 212 0.64 0.64 0.09 0.49
pam om quarter 5 1 0.57 0.60 0.13 0.74 0.36 0.47 3.24 4674 680 319 207 158 0.64 0.65 0.24 0.51 -0.05
pam om quarter 6 1 0.59 0.60 0.10 0.78 0.39 0.50 4.60 4476 680 318 207 203 154 0.68 0.64 0.23 0.50 0.01 -0.06
pam om quarter 7 1 0.61 0.60 0.08 0.82 0.41 0.52 6.25 4338 680 302 209 195 161 153 0.71 0.64 0.22 0.47 0.01 -0.04 -0.08
pam om quarter 12 1 0.61 0.60 0.07 0.85 0.49 0.58 7.41 3988 680 232 204 135 134 131 118 113 112 104 87 0.72 0.61 0.28 0.50 -0.13 0.16 0.08 0.46 0.22 -0.04 0.26 0.32
pam om quarter 15 1 0.61 0.60 0.05 0.87 0.53 0.61 10.61 3785 680 217 205 137 131 130 127 111 107 92 88 85 81 62 0.75 0.60 0.28 0.47 -0.06 0.13 0.04 0.37 0.17 0.05 0.61 0.20 0.33 0.54 -0.10
hac om quarter 4 0.49 0.59 0.20 0.65 0.29 0.37 1.59 4910 678 241 209 0.62 0.68 -0.10 0.53
hac lcs quarter 15 0.55 0.59 0.03 0.93 0.55 0.65 17.05 3117 1257 458 212 200 194 164 135 110 83 64 20 13 6 5 1.00 -0.16 1.00 0.47 -0.18 0.40 -0.03 0.17 -0.02 0.00 -0.05 0.03 0.05 0.47 -0.03
pam om quarter 8 0 0.59 0.59 0.09 0.80 0.43 0.53 5.24 4269 680 313 205 157 142 137 135 0.68 0.63 0.20 0.52 0.18 -0.08 0.13 0.24
pam om quarter 9 0 0.60 0.59 0.09 0.81 0.45 0.54 5.40 4164 680 313 204 156 142 137 132 110 0.70 0.63 0.18 0.52 0.17 -0.09 0.11 0.25 0.21
pam om quarter 10 0 0.61 0.59 0.08 0.84 0.46 0.56 6.40 4063 680 313 204 154 142 137 128 111 106 0.72 0.62 0.17 0.51 0.16 -0.11 0.10 0.26 -0.03 0.26
pam om quarter 11 0 0.61 0.59 0.07 0.84 0.48 0.57 7.32 3988 680 313 204 152 142 130 113 111 106 99 0.72 0.61 0.15 0.50 0.16 -0.12 0.11 0.35 -0.04 0.25 0.36
pam om quarter 8 1 0.61 0.59 0.08 0.82 0.43 0.53 6.25 4228 680 282 209 182 165 152 140 0.70 0.63 0.26 0.47 -0.08 0.04 -0.08 0.29
pam om quarter 10 1 0.61 0.59 0.08 0.84 0.47 0.56 6.40 4063 680 232 219 204 144 141 125 118 112 0.72 0.62 0.29 0.01 0.51 0.15 -0.11 0.40 0.15 -0.03
pam om quarter 11 1 0.61 0.59 0.07 0.84 0.48 0.57 7.32 3988 680 313 204 141 134 131 118 113 112 104 0.72 0.61 0.15 0.50 -0.12 0.16 0.09 0.46 0.22 -0.04 0.26
pam om quarter 14 1 0.61 0.59 0.05 0.87 0.51 0.60 10.61 3837 680 232 203 135 131 131 117 116 106 89 89 87 85 0.73 0.60 0.25 0.49 -0.14 0.35 0.06 0.02 0.17 -0.03 0.67 0.19 0.32 0.34
pam om quarter 9 1 0.60 0.58 0.09 0.81 0.45 0.54 5.40 4164 680 313 204 162 142 130 128 115 0.69 0.63 0.18 0.51 0.07 -0.09 0.13 0.39 0.18
pam om quarter 13 1 0.61 0.58 0.06 0.86 0.50 0.59 8.74 3909 680 232 203 135 131 130 114 114 109 105 89 87 0.71 0.61 0.26 0.50 -0.13 0.07 0.39 0.20 0.08 -0.05 0.08 0.67 0.32
hac om quarter 6 0.53 0.57 0.14 0.72 0.35 0.44 2.73 4502 678 408 226 209 15 0.64 0.66 -0.08 -0.07 0.51 0.22
hac lcs quarter 13 0.55 0.57 0.03 0.91 0.53 0.63 16.68 3117 1469 458 200 194 164 135 110 83 64 25 13 6 1.00 -0.15 1.00 -0.18 0.40 -0.03 0.41 -0.01 0.02 -0.05 -0.11 0.05 0.47
hac lcs quarter 14 0.55 0.57 0.03 0.91 0.54 0.64 16.68 3117 1469 458 200 194 164 135 110 83 64 20 13 6 5 1.00 -0.15 1.00 -0.18 0.40 -0.03 0.41 -0.01 0.02 -0.05 0.03 0.05 0.47 -0.03
pam om quarter 3 0 0.45 0.57 0.23 0.64 0.25 0.31 1.25 4982 688 368 0.59 0.64 0.07
pam om quarter 3 1 0.45 0.57 0.23 0.64 0.25 0.31 1.25 4982 688 368 0.59 0.64 0.07
hac om quarter 2 0.38 0.56 0.29 0.57 0.20 0.23 0.75 5151 887 0.58 0.44
hac om quarter 3 0.48 0.56 0.20 0.65 0.24 0.31 1.56 4910 887 241 0.62 0.41 -0.10
hac om quarter 5 0.53 0.56 0.14 0.72 0.34 0.41 2.73 4502 678 408 241 209 0.65 0.66 -0.07 -0.14 0.51
hac om quarter 15 0.58 0.56 0.08 0.82 0.49 0.60 5.94 3886 678 209 184 175 171 152 145 141 100 85 70 16 15 11 0.69 0.62 0.47 -0.05 0.53 0.13 0.23 -0.17 0.07 0.57 -0.09 -0.12 -0.15 0.10 0.06
pam om quarter 2 0 0.34 0.56 0.33 0.55 0.19 0.22 0.57 5348 690 0.55 0.65
pam om quarter 2 1 0.34 0.56 0.33 0.55 0.19 0.22 0.57 5348 690 0.55 0.65
pam lcs quarter 11 1 0.59 0.56 0.04 0.93 0.46 0.60 13.72 4098 638 269 192 179 168 153 134 98 66 43 0.67 0.57 0.32 -0.12 0.49 0.07 0.26 0.02 0.40 0.11 0.00
pam lcs quarter 12 1 0.59 0.56 0.03 0.95 0.47 0.61 18.68 4019 634 269 186 185 174 155 128 100 79 66 43 0.69 0.58 0.30 0.45 -0.21 0.04 0.28 0.03 0.46 0.36 0.11 0.00
pam lcs quarter 15 1 0.59 0.56 0.02 0.96 0.51 0.63 28.32 3817 638 269 192 177 168 134 109 108 102 80 69 66 66 43 0.70 0.54 0.28 -0.19 0.47 0.05 0.00 0.33 0.11 0.67 0.29 0.75 0.49 0.10 0.00
hac om quarter 9 0.58 0.55 0.10 0.78 0.40 0.52 4.52 4341 678 327 226 209 145 81 16 15 0.64 0.65 0.16 -0.11 0.50 -0.11 -0.16 -0.03 0.19
hac om quarter 10 0.58 0.55 0.10 0.80 0.42 0.54 4.64 4157 678 327 226 209 184 145 81 16 15 0.67 0.64 0.14 -0.13 0.49 0.03 -0.13 -0.17 -0.07 0.19
hac om quarter 11 0.58 0.55 0.10 0.80 0.43 0.55 4.64 4157 678 327 209 184 145 141 85 81 16 15 0.67 0.64 0.11 0.48 0.03 -0.13 0.12 -0.08 -0.17 -0.07 0.15
hac om quarter 12 0.58 0.55 0.10 0.80 0.45 0.57 4.64 4157 678 209 184 175 152 145 141 85 81 16 15 0.64 0.64 0.48 0.02 0.55 0.25 -0.15 0.10 -0.09 -0.20 -0.07 0.14
hac lcs quarter 11 0.54 0.55 0.04 0.91 0.51 0.61 12.29 3117 1469 658 194 164 135 110 96 64 25 6 1.00 -0.15 0.48 0.40 -0.03 0.41 0.00 -0.06 -0.04 -0.10 0.52
hac lcs quarter 12 0.54 0.55 0.04 0.91 0.51 0.62 12.29 3117 1469 658 194 164 135 110 83 64 25 13 6 1.00 -0.15 0.48 0.40 -0.03 0.41 -0.01 0.02 -0.05 -0.10 0.05 0.47
pam lcs quarter 10 1 0.58 0.55 0.05 0.92 0.44 0.56 10.67 4126 641 260 252 179 162 132 109 100 77 0.66 0.57 -0.15 0.39 0.49 0.07 -0.08 0.32 0.48 0.02
pam lcs quarter 13 1 0.59 0.55 0.03 0.94 0.49 0.61 18.49 3949 648 269 186 176 144 127 127 101 100 99 69 43 0.67 0.52 0.30 0.45 0.03 -0.16 0.03 0.09 0.67 0.34 0.50 0.08 0.00
hac om quarter 7 0.54 0.54 0.14 0.72 0.37 0.48 2.78 4502 678 327 226 209 81 15 0.59 0.66 0.19 -0.09 0.51 -0.14 0.19
hac om quarter 8 0.56 0.54 0.13 0.74 0.38 0.50 3.19 4486 678 327 226 209 81 16 15 0.60 0.66 0.18 -0.10 0.51 -0.14 -0.02 0.19
hac om quarter 13 0.58 0.54 0.08 0.82 0.47 0.58 5.94 3886 678 271 209 184 175 152 145 141 85 81 16 15 0.69 0.63 -0.05 0.47 -0.01 0.54 0.24 -0.17 0.08 -0.09 -0.21 -0.12 0.14
hac om quarter 14 0.58 0.54 0.08 0.82 0.47 0.59 5.94 3886 678 271 209 184 175 152 145 141 85 70 16 15 11 0.69 0.63 -0.05 0.47 -0.01 0.54 0.24 -0.17 0.08 -0.09 -0.12 -0.12 0.10 0.06
hac lcs quarter 9 0.53 0.54 0.05 0.87 0.49 0.58 9.22 3117 1633 658 194 174 135 96 25 6 1.00 -0.17 0.48 0.40 -0.09 0.42 -0.05 -0.01 0.59
hac lcs quarter 10 0.53 0.54 0.05 0.88 0.49 0.59 9.33 3117 1633 658 194 135 110 96 64 25 6 1.00 -0.17 0.48 0.40 0.42 0.00 -0.06 -0.04 -0.01 0.52
pam lcs quarter 6 1 0.54 0.54 0.12 0.84 0.36 0.47 3.78 4430 672 315 233 196 192 0.62 0.52 0.22 -0.06 0.43 0.11
pam lcs quarter 11 0 0.59 0.53 0.04 0.93 0.46 0.57 13.72 4046 675 253 206 181 179 132 110 99 81 76 0.65 0.47 -0.06 -0.05 0.62 0.48 -0.08 0.38 0.37 0.37 0.03
pam lcs quarter 7 1 0.56 0.53 0.09 0.87 0.39 0.51 5.41 4370 641 264 254 179 178 152 0.60 0.60 -0.09 0.40 0.04 0.53 -0.07
hac lcs quarter 8 0.52 0.52 0.07 0.84 0.44 0.55 6.24 3311 1633 658 174 135 96 25 6 0.89 -0.13 0.49 -0.09 0.42 -0.04 0.00 0.59
pam lcs quarter 6 0 0.54 0.52 0.12 0.84 0.36 0.47 3.78 4430 678 267 237 233 193 0.59 0.51 0.41 -0.06 0.00 0.45
pam lcs quarter 10 0 0.57 0.52 0.05 0.91 0.44 0.55 10.37 4077 677 274 206 181 178 152 110 101 82 0.64 0.47 -0.09 -0.04 0.62 0.50 -0.08 0.38 0.34 0.36
pam lcs quarter 15 0 0.58 0.52 0.02 0.95 0.51 0.63 27.55 3817 673 259 206 179 178 128 110 98 80 70 69 68 64 39 0.65 0.44 -0.08 -0.17 0.45 0.61 0.03 0.24 0.27 0.30 1.00 0.06 0.74 0.54 0.04
pam lcs quarter 4 1 0.54 0.52 0.15 0.82 0.28 0.41 2.95 4883 669 307 179 0.56 0.56 0.12 -0.05
hac lcs quarter 6 0.50 0.51 0.09 0.81 0.41 0.49 4.50 3311 1768 658 270 25 6 0.90 -0.13 0.49 -0.08 0.01 0.60
hac lcs quarter 7 0.51 0.51 0.07 0.84 0.43 0.52 6.12 3311 1633 658 270 135 25 6 0.89 -0.13 0.49 -0.15 0.43 0.00 0.60
pam lcs quarter 5 0 0.52 0.51 0.16 0.81 0.32 0.44 2.63 4611 678 314 218 217 0.57 0.52 0.25 0.07 -0.04
pam lcs quarter 9 0 0.57 0.51 0.06 0.90 0.42 0.53 8.55 4159 677 274 206 181 178 152 110 101 0.61 0.48 -0.08 -0.03 0.63 0.51 -0.07 0.40 0.37
pam lcs quarter 14 0 0.58 0.51 0.03 0.94 0.50 0.59 18.17 3841 675 253 206 181 179 132 110 99 81 76 70 69 66 0.63 0.44 -0.07 -0.17 0.60 0.45 -0.08 0.24 0.27 0.31 0.03 1.00 0.73 0.52
pam lcs quarter 5 1 0.52 0.51 0.16 0.81 0.32 0.43 2.63 4611 672 315 240 200 0.57 0.54 0.25 -0.07 0.12
pam lcs quarter 9 1 0.58 0.51 0.06 0.91 0.42 0.55 8.80 4223 621 260 222 177 172 152 132 79 0.59 0.62 -0.12 -0.01 0.66 0.53 0.16 -0.06 0.03
pam lcs quarter 14 1 0.59 0.51 0.02 0.95 0.50 0.62 28.02 3878 638 269 245 179 167 125 103 90 86 80 70 65 43 0.63 0.55 0.28 -0.23 0.46 0.05 0.04 0.31 0.43 0.26 0.40 1.00 0.11 -0.01
hac lcs quarter 4 0.49 0.50 0.09 0.80 0.39 0.43 4.36 3311 1768 658 301 0.90 -0.13 0.49 -0.13
hac lcs quarter 5 0.49 0.50 0.09 0.80 0.40 0.46 4.36 3311 1768 658 276 25 0.90 -0.13 0.49 -0.09 0.01
pam lcs quarter 3 0 0.46 0.50 0.21 0.74 0.23 0.32 1.62 5032 678 328 0.52 0.55 0.03
pam lcs quarter 4 0 0.50 0.50 0.18 0.79 0.27 0.37 2.19 4826 678 328 206 0.55 0.53 0.00 0.11
pam lcs quarter 8 0 0.56 0.50 0.08 0.88 0.40 0.52 6.16 4261 677 278 206 181 178 147 110 0.58 0.49 -0.08 0.00 0.64 0.51 -0.07 0.43
pam lcs quarter 13 0 0.58 0.50 0.03 0.94 0.48 0.59 18.17 3903 675 253 206 181 179 132 110 87 85 81 76 70 0.61 0.45 -0.06 -0.16 0.60 0.46 -0.08 0.25 0.31 0.55 0.32 0.03 1.00
pam lcs quarter 3 1 0.46 0.50 0.21 0.74 0.23 0.32 1.62 5032 678 328 0.52 0.55 0.03
pam lcs quarter 8 1 0.57 0.50 0.07 0.89 0.41 0.52 7.25 4259 636 264 251 187 178 149 114 0.58 0.60 -0.12 -0.05 0.45 0.65 -0.07 0.31
pam lcs quarter 7 0 0.56 0.48 0.09 0.87 0.38 0.50 5.41 4371 677 278 206 181 178 147 0.55 0.51 -0.07 0.04 0.65 0.53 -0.07
pam lcs quarter 12 0 0.58 0.48 0.04 0.93 0.47 0.58 13.48 3976 675 253 206 181 179 132 110 99 81 76 70 0.58 0.46 -0.06 -0.15 0.61 0.47 -0.08 0.25 0.36 0.36 0.03 1.00
hac lcs quarter 3 0.48 0.46 0.15 0.76 0.27 0.35 2.43 3969 1768 301 0.71 -0.02 -0.12
pam lcs quarter 2 0 0.22 0.45 0.43 0.51 0.13 0.14 0.26 5357 681 0.43 0.57
pam lcs quarter 2 1 0.22 0.45 0.43 0.51 0.13 0.14 0.26 5357 681 0.43 0.57

Tiempo que demora esta sección: 0 minutos

Se identificó una solución de 2, 4 y 7 conglomerados mediante el algoritmo de partición alrededor de medoides (PAM), utilizando distancias de emparejamiento óptimo (OM). Para validar la robustez de esta tipología, se implementó un procedimiento de bootstrap paramétrico con 1000 réplicas, comparando la calidad de la solución observada con la obtenida al aplicar el mismo procedimiento de clustering a datos generados bajo un modelo nulo combinado. Este modelo nulo evalúa la calidad de la agrupación en ausencia de estructura real, considerando aspectos combinados de duración y secuencia (comb), así como la secuencia por sí sola (seq), según la metodología propuesta por Studer (2021). Se busca medir cuánta calidad obtenida por la tipología sobrepasa la que habría sido obtenida para datos sin una estructura de conglomerados. El criterio Max T obtiene los máximos puntajes para las trayectorias que asumen estructuras aleatorias sobre las que comparar la solución de conglomerados obtenida.@studer_validating_2021

Code
# results: hide
# fig.show: hide

opar <- par(no.readonly = TRUE)

#par(mfrow = c(2, 2)) # 2 filas, 2 columnas

#https://sequenceanalysis.org/2023/10/19/validating-sequence-analysis-typologies-using-parametric-bootstrap/

cbind.data.frame(
  algo= c(rep("HAC LCS",4), rep("PAM OM", 6)),
  type= c(rep("Duración y Secuencia",2),rep("Secuencia",2),rep("Duración y Secuencia",3),rep("Secuencia",3)),
  conglomerados= c(rep(c("2", "MaxT 95%"),2), rep(c("4", "7", "MaxT 95%"),2)), rbind.data.frame(hac_lcs_quarter_null_comb_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")], hac_lcs_quarter_null_seq_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")], pam_om_quarter_null_comb_print$results_df[c(3,6,16),c("ASW", "HG", "PBC", "HC")], pam_om_quarter_null_seq_print$results_df[c(3,6,16),c("ASW", "HG", "PBC", "HC")]))%>% 
    `rownames<-`(NULL) %>%
    { 
        rio::export(., "_output/sol_conglomerados_tab_validacion_quarter.xlsx")            
        knitr::kable(., "markdown", caption = "Validación CQIs conglomerados (trimestre)")
    }
Validación CQIs conglomerados (trimestre)
algo type conglomerados ASW HG PBC HC
HAC LCS Duración y Secuencia 2 0.7 0.94 0.61 0.11
HAC LCS Duración y Secuencia MaxT 95% [0.47; 0.59] [0.94; 0.98] [0.7; 0.83] [0.17; 0.27]
HAC LCS Secuencia 2 0.7 0.94 0.61 0.11
HAC LCS Secuencia MaxT 95% [0.37; 0.51] [0.75; 0.87] [0.44; 0.63] [0.22; 0.32]
PAM OM Duración y Secuencia 4 0.6 0.67 0.5 0.18
PAM OM Duración y Secuencia 7 0.61 0.79 0.6 0.09
PAM OM Duración y Secuencia MaxT 95% [0.56; 0.58] [0.94; 0.96] [0.73; 0.77] [0.17; 0.18]
PAM OM Secuencia 4 0.6 0.67 0.5 0.18
PAM OM Secuencia 7 0.61 0.79 0.6 0.09
PAM OM Secuencia MaxT 95% [0.36; 0.43] [0.68; 0.74] [0.38; 0.43] [0.26; 0.29]

Tiempo que demora esta sección: 0 minutos

Se descartó la solución de 2 conglomerados por ser demasiado simple y, por lo tanto, carecer de valor explicativo en relación con los estados discretos de interés (a saber, las causas de hospitalización). En contraste con una estructura de trayectoria de duración y secuencia aleatoria, los valores obtenidos en los índices Gamma de Hubbert (HG) y Correlación Punto-Biserial (PBC) se encuentran dentro del intervalo esperado para la solución de 7 conglomerados, mientras que para la solución de 4 conglomerados, el índice C de Hubbert también se encuentra dentro de ese intervalo sumado a los otros. Esto significa que sólo el ASW de la solución de 4 conglomerados es mayor que lo esperado. Ahora, en comparación a una estructura de trayectorias aleatoria en términos secuencias, ambas soluciones tienen valores de ASW, HC y PBC superiores al esperable, mientras que en el caso del índice HG sólo es superior al esperable para la solución de 7 conglomerados.

A continuación se muestra con más detalle el resultado de pruebas de validación mediante bootstraps.

Code
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_comb <- plot_grid(
  asw_grob, hc_grob, hg_grob, pbc_grob,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_comb, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Code
ggsave("_figs/pam_om_quarter_comb_qci.png", final_plot_comb, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

Code
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_seq <- plot_grid(
  asw_grob, hc_grob, hg_grob, pbc_grob,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_seq, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias aleatorias

Indicadores de calidad vs. bootstrap con secuencias aleatorias

Code
ggsave("_figs/pam_om_quarter_seq_qci.png", final_plot_seq, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

0.c.2. Mensual

Code

pamRange_month_om2<- wcKMedRange(dist_month_om, kvals= 2:15, initialclust= lcs_dist_month)
pamRange_month_lcs2<- wcKMedRange(dist_month_lcs, kvals= 2:15, initialclust= lcs_dist_month)

as <- new.env()
options(width = 1e4) #para ampliar la vista del capture output
load("_perm/null_ssa_om_month_null_comb_20240905.Rda", envir = as)
hac_om_month_null_comb_stats<-as$om_month_null_comb$stats
hac_om_month_null_comb_print<-print.seqnullcqi.powder(as$om_month_null_comb)
plot(as$om_month_null_comb, "ASW")
hac_om_month_null_comb_plot_asw <- recordPlot()
plot(as$om_month_null_comb, "HC")
hac_om_month_null_comb_plot_hc <- recordPlot()
plot(as$om_month_null_comb, "HG")
hac_om_month_null_comb_plot_hg <- recordPlot()
plot(as$om_month_null_comb, "PBC")
hac_om_month_null_comb_plot_pbc <- recordPlot()

plot(as$om_month_null_comb, "ASW", type="density")
hac_om_month_null_comb_plot_dens_asw <- recordPlot()
plot(as$om_month_null_comb, "HC", type="density")
hac_om_month_null_comb_plot_dens_hc <- recordPlot()
plot(as$om_month_null_comb, "HG", type="density")
hac_om_month_null_comb_plot_dens_hg <- recordPlot()
plot(as$om_month_null_comb, "PBC", type="density")
hac_om_month_null_comb_plot_dens_pbc <- recordPlot()

rm(om_month_null_comb, envir = as)

load("_perm/null_ssa_om_month_null_seq_20240905.Rda", envir = as)
hac_om_month_null_seq_stats<-as$om_month_null_seq$stats
hac_om_month_null_seq_print<-print.seqnullcqi.powder(as$om_month_null_seq)
plot(as$om_month_null_seq, "ASW")
hac_om_month_null_seq_plot_asw <- recordPlot()
plot(as$om_month_null_seq, "HC")
hac_om_month_null_seq_plot_hc <- recordPlot()
plot(as$om_month_null_seq, "HG")
hac_om_month_null_seq_plot_hg <- recordPlot()
plot(as$om_month_null_seq, "PBC")
hac_om_month_null_seq_plot_pbc <- recordPlot()

plot(as$om_month_null_seq, "ASW", type="density")
hac_om_month_null_seq_plot_dens_asw <- recordPlot()
plot(as$om_month_null_seq, "HC", type="density")
hac_om_month_null_seq_plot_dens_hc <- recordPlot()
plot(as$om_month_null_seq, "HG", type="density")
hac_om_month_null_seq_plot_dens_hg <- recordPlot()
plot(as$om_month_null_seq, "PBC", type="density")
hac_om_month_null_seq_plot_dens_pbc <- recordPlot()

rm(om_month_null_seq, envir = as)

load("_perm/null_ssa_lcs_month_null_comb_20240905.Rda", envir = as)
hac_lcs_month_null_comb_stats<-as$lcs_month_null_comb$stats
hac_lcs_month_null_comb_print<-print.seqnullcqi.powder(as$lcs_month_null_comb)
plot(as$lcs_month_null_comb, "ASW")
hac_lcs_month_null_comb_plot_asw <- recordPlot()
plot(as$lcs_month_null_comb, "HC")
hac_lcs_month_null_comb_plot_hc <- recordPlot()
plot(as$lcs_month_null_comb, "HG")
hac_lcs_month_null_comb_plot_hg <- recordPlot()
plot(as$lcs_month_null_comb, "PBC")
hac_lcs_month_null_comb_plot_pbc <- recordPlot()

plot(as$lcs_month_null_comb, "ASW", type="density")
hac_lcs_month_null_comb_plot_dens_asw <- recordPlot()
plot(as$lcs_month_null_comb, "HC", type="density")
hac_lcs_month_null_comb_plot_dens_hc <- recordPlot()
plot(as$lcs_month_null_comb, "HG", type="density")
hac_lcs_month_null_comb_plot_dens_hg <- recordPlot()
plot(as$lcs_month_null_comb, "PBC", type="density")
hac_lcs_month_null_comb_plot_dens_pbc <- recordPlot()

rm(lcs_month_null_comb, envir = as)

load("_perm/null_ssa_lcs_month_null_seq_20240905.Rda", envir = as)
hac_lcs_month_null_seq_stats<-as$lcs_month_null_seq$stats
hac_lcs_month_null_seq_print<-print.seqnullcqi.powder(as$lcs_month_null_seq)
plot(as$lcs_month_null_seq, "ASW")
hac_lcs_month_null_seq_plot_asw <- recordPlot()
plot(as$lcs_month_null_seq, "HC")
hac_lcs_month_null_seq_plot_hc <- recordPlot()
plot(as$lcs_month_null_seq, "HG")
hac_lcs_month_null_seq_plot_hg <- recordPlot()
plot(as$lcs_month_null_seq, "PBC")
hac_lcs_month_null_seq_plot_pbc <- recordPlot()

plot(as$lcs_month_null_seq, "ASW", type="density")
hac_lcs_month_null_seq_plot_dens_asw <- recordPlot()
plot(as$lcs_month_null_seq, "HC", type="density")
hac_lcs_month_null_seq_plot_dens_hc <- recordPlot()
plot(as$lcs_month_null_seq, "HG", type="density")
hac_lcs_month_null_seq_plot_dens_hg <- recordPlot()
plot(as$lcs_month_null_seq, "PBC", type="density")
hac_lcs_month_null_seq_plot_dens_pbc <- recordPlot()

rm(lcs_month_null_seq, envir = as)

load("_perm/null_ssa_pam_month_om_comb_20241221.Rda", envir = as)
pam_om_month_null_comb_stats<-as$pam_om_month_null_comb$stats
pam_om_month_null_comb_print<-print.seqnullcqi.powder(as$pam_om_month_null_comb)
plot(as$pam_om_month_null_comb, "ASW")
pam_om_month_null_comb_plot_asw <- recordPlot()
plot(as$pam_om_month_null_comb, "HC")
pam_om_month_null_comb_plot_hc <- recordPlot()
plot(as$pam_om_month_null_comb, "HG")
pam_om_month_null_comb_plot_hg <- recordPlot()
plot(as$pam_om_month_null_comb, "PBC")
pam_om_month_null_comb_plot_pbc <- recordPlot()

plot(as$pam_om_month_null_comb, "ASW", type="density")
pam_om_month_null_comb_plot_dens_asw <- recordPlot()
plot(as$pam_om_month_null_comb, "HC", type="density")
pam_om_month_null_comb_plot_dens_hc <- recordPlot()
plot(as$pam_om_month_null_comb, "HG", type="density")
pam_om_month_null_comb_plot_dens_hg <- recordPlot()
plot(as$pam_om_month_null_comb, "PBC", type="density")
pam_om_month_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_comb, envir = as)

load("_perm/null_ssa_pam_month_om_seq_20241221.Rda", envir = as)
pam_om_month_null_seq_stats<-as$pam_om_month_null_seq$stats
pam_om_month_null_seq_print<-print.seqnullcqi.powder(as$pam_om_month_null_seq)
plot(as$pam_om_month_null_seq, "ASW")
pam_om_month_null_seq_plot_asw <- recordPlot()
plot(as$pam_om_month_null_seq, "HC")
pam_om_month_null_seq_plot_hc <- recordPlot()
plot(as$pam_om_month_null_seq, "HG")
pam_om_month_null_seq_plot_hg <- recordPlot()
plot(as$pam_om_month_null_seq, "PBC")
pam_om_month_null_seq_plot_pbc <- recordPlot()

plot(as$pam_om_month_null_seq, "ASW", type="density")
pam_om_month_null_seq_plot_dens_asw <- recordPlot()
plot(as$pam_om_month_null_seq, "HC", type="density")
pam_om_month_null_seq_plot_dens_hc <- recordPlot()
plot(as$pam_om_month_null_seq, "HG", type="density")
pam_om_month_null_seq_plot_dens_hg <- recordPlot()
plot(as$pam_om_month_null_seq, "PBC", type="density")
pam_om_month_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_seq, envir = as)

load("_perm/null_ssa_pam_month_lcs_comb_20241221.Rda", envir = as)
pam_lcs_month_null_comb_stats<-as$pam_lcs_month_null_comb$stats
pam_lcs_month_null_comb_print<-print.seqnullcqi.powder(as$pam_lcs_month_null_comb)
plot(as$pam_lcs_month_null_comb, "ASW")
pam_lcs_month_null_comb_plot_asw <- recordPlot()
plot(as$pam_lcs_month_null_comb, "HC")
pam_lcs_month_null_comb_plot_hc <- recordPlot()
plot(as$pam_lcs_month_null_comb, "HG")
pam_lcs_month_null_comb_plot_hg <- recordPlot()
plot(as$pam_lcs_month_null_comb, "PBC")
pam_lcs_month_null_comb_plot_pbc <- recordPlot()

plot(as$pam_lcs_month_null_comb, "ASW", type="density")
pam_lcs_month_null_comb_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_month_null_comb, "HC", type="density")
pam_lcs_month_null_comb_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_month_null_comb, "HG", type="density")
pam_lcs_month_null_comb_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_month_null_comb, "PBC", type="density")
pam_lcs_month_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_comb, envir = as)

load("_perm/null_ssa_pam_month_lcs_seq_20241221.Rda", envir = as)
pam_lcs_month_null_seq_stats<-as$pam_lcs_month_null_seq$stats
pam_lcs_month_null_seq_print<-print.seqnullcqi.powder(as$pam_lcs_month_null_seq)
plot(as$pam_lcs_month_null_seq, "ASW")
pam_lcs_month_null_seq_plot_asw <- recordPlot()
plot(as$pam_lcs_month_null_seq, "HC")
pam_lcs_month_null_seq_plot_hc <- recordPlot()
plot(as$pam_lcs_month_null_seq, "HG")
pam_lcs_month_null_seq_plot_hg <- recordPlot()
plot(as$pam_lcs_month_null_seq, "PBC")
pam_lcs_month_null_seq_plot_pbc <- recordPlot()

plot(as$pam_lcs_month_null_seq, "ASW", type="density")
pam_lcs_month_null_seq_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_month_null_seq, "HC", type="density")
pam_lcs_month_null_seq_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_month_null_seq, "HG", type="density")
pam_lcs_month_null_seq_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_month_null_seq, "PBC", type="density")
pam_lcs_month_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_seq, envir = as)


# > #null_ssa_pam_quarter_lcs_comb2_20241221.Rda
# > #null_ssa_pam_month_lcs_seq2_20241221.Rda
# > #null_ssa_pam_month_lcs_comb2_20241221.Rda
# > #null_ssa_pam_om_quarter_null_seq2_20241221.Rda
# > #null_ssa_pam_om_quarter_null_comb2_20241221.Rda
# > #null_ssa_pam_quarter_lcs_comb2_20241221.Rda
# > #null_ssa_pam_quarter_lcs_seq2_20241221.Rda
# > #null_ssa_pam_om_month_null_seq2_20241221.Rda

load("_perm/null_ssa_pam_om_month_null_comb2_20241226.Rda", envir = as)
pam_om_month_null_comb2_stats<-as$pam_om_month_null_comb2$stats
pam_om_month_null_comb2_print<-print.seqnullcqi.powder(as$pam_om_month_null_comb2)
plot(as$pam_om_month_null_comb2, "ASW")
pam_om_month_null_comb2_plot_asw <- recordPlot()
plot(as$pam_om_month_null_comb2, "HC")
pam_om_month_null_comb2_plot_hc <- recordPlot()
plot(as$pam_om_month_null_comb2, "HG")
pam_om_month_null_comb2_plot_hg <- recordPlot()
plot(as$pam_om_month_null_comb2, "PBC")
pam_om_month_null_comb2_plot_pbc <- recordPlot()

plot(as$pam_om_month_null_comb2, "ASW", type="density")
pam_om_month_null_comb2_plot_dens_asw <- recordPlot()
plot(as$pam_om_month_null_comb2, "HC", type="density")
pam_om_month_null_comb2_plot_dens_hc <- recordPlot()
plot(as$pam_om_month_null_comb2, "HG", type="density")
pam_om_month_null_comb2_plot_dens_hg <- recordPlot()
plot(as$pam_om_month_null_comb2, "PBC", type="density")
pam_om_month_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_comb2, envir = as)
invisible("no existe!!!- hasta el 12-26")

load("_perm/null_ssa_pam_om_month_null_seq2_20241221.Rda", envir = as)
pam_om_month_null_seq2_stats<-as$pam_om_month_null_seq2$stats
pam_om_month_null_seq2_print<-print.seqnullcqi.powder(as$pam_om_month_null_seq2)
plot(as$pam_om_month_null_seq2, "ASW")
pam_om_month_null_seq2_plot_asw <- recordPlot()
plot(as$pam_om_month_null_seq2, "HC")
pam_om_month_null_seq2_plot_hc <- recordPlot()
plot(as$pam_om_month_null_seq2, "HG")
pam_om_month_null_seq2_plot_hg <- recordPlot()
plot(as$pam_om_month_null_seq2, "PBC")
pam_om_month_null_seq2_plot_pbc <- recordPlot()

plot(as$pam_om_month_null_seq2, "ASW", type="density")
pam_om_month_null_seq2_plot_dens_asw <- recordPlot()
plot(as$pam_om_month_null_seq2, "HC", type="density")
pam_om_month_null_seq2_plot_dens_hc <- recordPlot()
plot(as$pam_om_month_null_seq2, "HG", type="density")
pam_om_month_null_seq2_plot_dens_hg <- recordPlot()
plot(as$pam_om_month_null_seq2, "PBC", type="density")
pam_om_month_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_seq2, envir = as)

load("_perm/null_ssa_pam_month_lcs_comb2_20241221.Rda", envir = as)
pam_lcs_month_null_comb2_stats<-as$pam_lcs_month_null_comb2$stats
pam_lcs_month_null_comb2_print<-print.seqnullcqi.powder(as$pam_lcs_month_null_comb2)
plot(as$pam_lcs_month_null_comb2, "ASW")
pam_lcs_month_null_comb2_plot_asw <- recordPlot()
plot(as$pam_lcs_month_null_comb2, "HC")
pam_lcs_month_null_comb2_plot_hc <- recordPlot()
plot(as$pam_lcs_month_null_comb2, "HG")
pam_lcs_month_null_comb2_plot_hg <- recordPlot()
plot(as$pam_lcs_month_null_comb2, "PBC")
pam_lcs_month_null_comb2_plot_pbc <- recordPlot()

plot(as$pam_lcs_month_null_comb2, "ASW", type="density")
pam_lcs_month_null_comb2_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_month_null_comb2, "HC", type="density")
pam_lcs_month_null_comb2_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_month_null_comb2, "HG", type="density")
pam_lcs_month_null_comb2_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_month_null_comb2, "PBC", type="density")
pam_lcs_month_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_comb2, envir = as)

load("_perm/null_ssa_pam_month_lcs_seq2_20241221.Rda", envir = as)
pam_lcs_month_null_seq2_stats<-as$pam_lcs_month_null_seq2$stats
pam_lcs_month_null_seq2_print<-print.seqnullcqi.powder(as$pam_lcs_month_null_seq2)
plot(as$pam_lcs_month_null_seq2, "ASW")
pam_lcs_month_null_seq2_plot_asw <- recordPlot()
plot(as$pam_lcs_month_null_seq2, "HC")
pam_lcs_month_null_seq2_plot_hc <- recordPlot()
plot(as$pam_lcs_month_null_seq2, "HG")
pam_lcs_month_null_seq2_plot_hg <- recordPlot()
plot(as$pam_lcs_month_null_seq2, "PBC")
pam_lcs_month_null_seq2_plot_pbc <- recordPlot()

plot(as$pam_lcs_month_null_seq2, "ASW", type="density")
pam_lcs_month_null_seq2_plot_dens_asw <- recordPlot()
plot(as$pam_lcs_month_null_seq2, "HC", type="density")
pam_lcs_month_null_seq2_plot_dens_hc <- recordPlot()
plot(as$pam_lcs_month_null_seq2, "HG", type="density")
pam_lcs_month_null_seq2_plot_dens_hg <- recordPlot()
plot(as$pam_lcs_month_null_seq2, "PBC", type="density")
pam_lcs_month_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_seq2, envir = as)

options(width = getOption("width"))

Tiempo que demora esta sección: 0.1 minutos

Code
cqi_month<-
rbind.data.frame(
cbind.data.frame(algo="hac", type="om", time="month", k=2:15, corr=F, om_dist_month_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="hac", type="lcs", time="month", k=2:15, corr=F, lcs_dist_month_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="month", k=2:15, corr=F, pamRange_month_om$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="month", k=2:15, corr=T, pamRange_month_om2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="month", k=2:15, corr=F, pamRange_month_lcs$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="month", k=2:15, corr=T, pamRange_month_lcs2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2)))
) |> 
  dplyr::select(algo, type, time, k, corr, PBC, ASW, HC, HG, R2, R2sq)

tabs_month_clus_sol<-
rbind.data.frame(
func_tab_range_clus(om_dist_month_c),
func_tab_range_clus(lcs_dist_month_c),
func_tab_range_clus(pamRange_month_om),
func_tab_range_clus(pamRange_month_om2),
func_tab_range_clus(pamRange_month_lcs),
func_tab_range_clus(pamRange_month_lcs2)
)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

# Inicializamos una lista para almacenar los resultados
resultados_list <- list()
# Definimos un rango para los clusters a evaluar
cluster_range <- 2:15
# Definimos los métodos y sus variables
metodos <- list(
    hac_om = list(data = om_dist_month_c, dist = dist_month_om),
    hac_lcs = list(data = lcs_dist_month_c, dist = dist_month_lcs),
    pam_om0 = list(data = pamRange_month_om, dist = dist_month_om),
    pam_om1 = list(data = pamRange_month_om2, dist = dist_month_om),
    pam_lcs0 = list(data = pamRange_month_lcs, dist = dist_month_lcs),
    pam_lcs1 = list(data = pamRange_month_lcs2, dist = dist_month_lcs)
)
# Número máximo de clusters para definir las columnas
max_clusters <- max(cluster_range)
# Iteramos sobre cada método
for (metodo in names(metodos)) {
    # Creamos un data frame temporal para cada método
    metodo_result <- data.frame()
    # Iteramos sobre cada cluster en el rango
    for (cluster in cluster_range) {
        # Construimos el nombre del cluster dinámicamente
        cluster_name <- paste0("cluster", cluster)
        # Intentamos calcular los valores de silhouette
        silhouette_values <- tryCatch(
            round(summary(silhouette(as.integer(metodos[[metodo]]$data$clustering[[cluster_name]]), as.dist(metodos[[metodo]]$dist)))$clus.avg.widths[attr(rev(sort(table(metodos[[metodo]]$data$clustering[[cluster_name]]))),"names")], 2),
            error = function(e) rep(NA, cluster)
        )
        # Creamos un vector con las columnas llenando con NA si faltan valores
        silhouette_full <- c(silhouette_values, rep(NA, max_clusters - length(silhouette_values)))
        # Creamos un data frame temporal con los resultados para este cluster
        cluster_result <- data.frame(
            Metodo = metodo,
            Cluster = cluster,
            t(silhouette_full) # Transponemos los valores para que cada uno sea una columna
        )
        # Nombramos dinámicamente las columnas de silhouette
        colnames(cluster_result)[3:(3 + max_clusters - 1)] <- paste0("asw", 1:max_clusters)
        # Añadimos el resultado del cluster al data frame del método
        metodo_result <- rbind(metodo_result, cluster_result)
    }
    # Agregamos los resultados del método a la lista general
    resultados_list[[metodo]] <- metodo_result
}
# Combinamos todos los resultados en un único data frame
avs_por_cluster_month <- do.call(rbind, resultados_list)
# Ordenamos por Método y Cluster
avs_por_cluster_month <- avs_por_cluster_month[order(avs_por_cluster_month$Metodo, avs_por_cluster_month$Cluster), ]


bind_cols(cqi_month, tabs_month_clus_sol)%>%
  dplyr::mutate(corr= dplyr::case_when(corr==TRUE & algo!="hac"~"1",corr==FALSE & algo!="hac"~"0",T~""), key= paste0(algo,"_",type,corr,"_",k))|> 
  left_join(dplyr::mutate(avs_por_cluster_month, key=paste0(Metodo,"_",Cluster)), by="key")|> 
  dplyr::select(-Metodo, -Cluster) |> 
            `rownames<-`(NULL) %>%
  dplyr::mutate(calc= round(PBC*(1/HC)*HG,2)) %>% 
  dplyr::arrange(desc(ASW)) %>%
  dplyr::select(c("algo", "type", "time", "k", "corr", "PBC", "ASW", "HC", "HG", "R2", "R2sq", "calc", paste0("X",1:15), paste0("asw",1:15)))%>% 
  {
    assign("asw_month_qci", dplyr::select(., -"time"), envir = .GlobalEnv)
    .
  } %>%
    { 
        rio::export(., "_output/sol_conglomerados_tab_month.xlsx")            
        knitr::kable(., "markdown", caption = "CQIs y frecuencias en conglomerados (mensual)")
    }
CQIs y frecuencias en conglomerados (mensual)
algo type time k corr PBC ASW HC HG R2 R2sq calc X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 asw1 asw2 asw3 asw4 asw5 asw6 asw7 asw8 asw9 asw10 asw11 asw12 asw13 asw14 asw15
hac om month 2 0.51 0.85 0.17 0.98 0.04 0.13 2.94 5998 40 0.85 -0.06
hac lcs month 2 0.53 0.60 0.14 0.85 0.15 0.21 3.22 5174 864 0.74 -0.22
hac lcs month 3 0.56 0.56 0.11 0.86 0.18 0.32 4.38 5174 758 106 0.67 -0.09 -0.20
hac lcs month 4 0.56 0.56 0.11 0.86 0.19 0.38 4.38 5174 758 100 6 0.67 -0.09 -0.18 0.19
hac om month 9 0.43 0.48 0.18 0.66 0.29 0.44 1.58 4595 683 301 203 179 37 35 3 2 0.54 0.56 0.08 -0.20 0.38 -0.12 -0.22 0.52 0.75
hac om month 10 0.43 0.48 0.18 0.66 0.29 0.46 1.58 4595 683 301 203 179 35 29 8 3 2 0.54 0.56 0.08 -0.20 0.38 -0.22 -0.10 0.34 0.46 0.75
hac om month 11 0.43 0.48 0.18 0.66 0.30 0.48 1.58 4595 683 301 203 179 32 29 8 3 3 2 0.54 0.56 0.08 -0.20 0.38 -0.17 -0.10 0.34 0.44 0.23 0.75
pam om month 15 0 0.45 0.48 0.10 0.76 0.40 0.51 3.42 3889 681 542 180 142 97 87 85 80 69 65 62 28 26 5 0.59 0.51 0.35 0.22 0.23 0.11 0.01 -0.11 -0.18 -0.14 -0.01 -0.20 0.00 -0.13 0.21
pam om month 13 1 0.44 0.48 0.11 0.75 0.39 0.50 3.00 3909 682 555 203 181 107 87 80 76 71 65 16 6 0.60 0.51 0.31 0.11 0.22 -0.17 -0.06 -0.17 0.08 -0.19 0.02 0.04 0.15
pam om month 15 1 0.45 0.48 0.10 0.76 0.41 0.53 3.42 3889 681 542 199 180 94 81 74 71 64 61 59 25 13 5 0.59 0.51 0.35 0.17 0.21 -0.12 -0.18 0.04 0.04 -0.17 0.02 -0.11 -0.12 0.07 0.17
pam om month 9 0 0.42 0.47 0.14 0.70 0.36 0.45 2.10 4076 687 571 215 184 123 87 80 15 0.55 0.51 0.30 0.12 0.24 -0.19 -0.03 -0.18 0.01
pam om month 10 0 0.43 0.47 0.13 0.72 0.37 0.46 2.38 4016 684 559 183 159 134 108 103 77 15 0.57 0.51 0.31 0.23 0.16 -0.05 -0.18 -0.06 -0.19 0.02
pam om month 12 0 0.43 0.47 0.12 0.73 0.38 0.49 2.62 3995 683 538 183 142 124 103 96 74 64 30 6 0.56 0.51 0.36 0.22 0.20 0.10 -0.09 -0.15 -0.19 -0.20 -0.03 0.19
pam om month 13 0 0.44 0.47 0.11 0.75 0.39 0.49 3.00 3918 683 538 183 142 124 103 95 79 73 64 30 6 0.58 0.51 0.35 0.21 0.20 0.10 -0.10 -0.15 -0.17 -0.19 -0.20 -0.03 0.19
pam om month 14 0 0.44 0.47 0.10 0.76 0.39 0.50 3.34 3895 682 547 180 145 99 89 85 80 70 65 65 30 6 0.60 0.51 0.32 0.22 0.15 0.08 -0.04 -0.11 -0.17 -0.14 -0.22 0.02 -0.03 0.20
pam om month 9 1 0.42 0.47 0.14 0.71 0.35 0.43 2.13 4057 686 572 184 177 142 121 78 21 0.56 0.51 0.28 0.23 0.12 -0.06 -0.18 -0.20 -0.07
pam om month 10 1 0.43 0.47 0.13 0.72 0.37 0.46 2.38 4016 684 559 183 159 134 108 103 77 15 0.57 0.51 0.31 0.23 0.16 -0.05 -0.18 -0.06 -0.19 0.02
pam om month 11 1 0.43 0.47 0.13 0.72 0.37 0.48 2.38 4016 684 559 183 147 127 105 104 77 30 6 0.57 0.51 0.31 0.23 0.14 0.07 -0.13 -0.09 -0.21 -0.01 0.20
pam om month 12 1 0.43 0.47 0.12 0.73 0.38 0.50 2.62 3986 682 555 203 181 105 92 77 71 64 16 6 0.57 0.51 0.33 0.11 0.24 -0.17 -0.08 0.08 -0.19 0.04 0.04 0.15
pam om month 14 1 0.44 0.47 0.10 0.76 0.40 0.51 3.34 3895 682 547 203 180 91 90 79 67 63 61 60 14 6 0.60 0.51 0.32 0.09 0.22 -0.05 -0.12 -0.17 -0.19 0.07 0.06 -0.11 0.06 0.15
hac om month 8 0.43 0.46 0.18 0.66 0.26 0.42 1.58 4595 862 301 203 37 35 3 2 0.55 0.34 0.09 -0.19 -0.12 -0.22 0.52 0.77
pam om month 6 0 0.39 0.46 0.18 0.64 0.31 0.36 1.39 4190 688 674 208 190 88 0.53 0.51 0.25 -0.03 0.23 -0.24
pam om month 7 0 0.41 0.46 0.16 0.68 0.33 0.38 1.74 4105 685 658 198 188 120 84 0.55 0.50 0.28 -0.03 0.23 -0.11 -0.25
pam om month 8 0 0.42 0.46 0.14 0.70 0.34 0.38 2.10 4076 687 571 213 184 128 91 88 0.55 0.51 0.30 0.11 0.24 -0.21 -0.14 -0.26
pam om month 11 0 0.43 0.46 0.12 0.73 0.38 0.47 2.62 3998 683 545 183 157 133 102 95 77 59 6 0.56 0.51 0.35 0.23 0.18 -0.05 -0.06 -0.12 -0.19 -0.22 0.20
pam om month 7 1 0.40 0.46 0.17 0.65 0.33 0.37 1.53 4164 686 583 190 175 147 93 0.54 0.52 0.25 0.23 0.18 -0.08 -0.26
pam om month 8 1 0.42 0.46 0.14 0.70 0.34 0.38 2.10 4076 687 571 217 184 124 91 88 0.55 0.51 0.30 0.08 0.24 -0.20 -0.13 -0.26
hac om month 4 0.37 0.45 0.25 0.58 0.21 0.28 0.86 4798 864 336 40 0.51 0.35 -0.07 -0.10
hac om month 5 0.37 0.45 0.25 0.58 0.21 0.32 0.86 4798 864 336 37 3 0.51 0.35 -0.07 -0.08 0.52
hac om month 6 0.38 0.45 0.25 0.58 0.22 0.35 0.88 4798 862 336 37 3 2 0.50 0.37 -0.08 -0.09 0.52 0.77
hac om month 7 0.38 0.45 0.24 0.58 0.23 0.39 0.92 4798 862 301 37 35 3 2 0.49 0.37 0.11 -0.10 -0.21 0.52 0.77
pam om month 5 0 0.36 0.45 0.21 0.61 0.28 0.30 1.05 4225 698 693 230 192 0.53 0.19 0.49 -0.17 0.21
pam om month 5 1 0.36 0.45 0.21 0.61 0.28 0.29 1.05 4225 693 613 315 192 0.53 0.49 0.19 -0.14 0.21
pam om month 6 1 0.37 0.45 0.20 0.62 0.30 0.33 1.15 4215 693 610 230 192 98 0.54 0.48 0.20 0.01 0.21 -0.16
pam lcs month 2 0 0.26 0.45 0.38 0.50 0.10 0.13 0.34 5145 893 0.53 -0.05
pam lcs month 2 1 0.26 0.45 0.38 0.50 0.10 0.13 0.34 5145 893 0.53 -0.05
pam lcs month 14 0 0.43 0.44 0.09 0.82 0.41 0.54 3.92 3851 677 534 170 159 114 101 77 76 75 71 58 57 18 0.56 0.39 0.31 0.14 0.35 -0.04 0.04 -0.18 -0.14 0.18 -0.12 -0.14 0.07 -0.02
pam lcs month 11 1 0.41 0.44 0.12 0.78 0.38 0.51 2.66 3938 681 627 168 166 115 101 85 82 57 18 0.55 0.38 0.30 0.12 0.17 -0.02 -0.15 0.14 -0.15 -0.04 0.00
pam lcs month 15 1 0.43 0.44 0.09 0.83 0.41 0.55 3.97 3843 670 527 167 166 121 90 84 73 68 67 58 55 35 14 0.56 0.41 0.36 0.16 0.15 -0.08 0.04 -0.10 -0.14 0.23 -0.03 -0.15 -0.09 -0.14 0.02
hac om month 3 0.28 0.43 0.36 0.45 0.16 0.23 0.35 5134 864 40 0.44 0.39 -0.07
hac om month 14 0.41 0.43 0.14 0.68 0.36 0.52 1.99 3967 683 613 265 203 179 36 32 29 15 8 3 3 2 0.54 0.53 0.07 0.10 -0.24 0.35 0.16 -0.20 -0.12 -0.17 0.27 0.44 0.23 0.75
hac om month 15 0.41 0.43 0.14 0.68 0.36 0.53 1.99 3967 683 613 265 179 149 54 36 32 29 15 8 3 3 2 0.54 0.53 0.07 0.10 0.35 -0.15 -0.16 0.16 -0.20 -0.14 -0.17 0.26 0.44 0.23 0.75
pam om month 3 0 0.30 0.43 0.28 0.53 0.22 0.21 0.57 4440 900 698 0.52 -0.06 0.49
pam om month 4 0 0.33 0.43 0.25 0.56 0.25 0.26 0.74 4404 706 698 230 0.48 0.21 0.49 -0.16
pam om month 3 1 0.30 0.43 0.28 0.53 0.22 0.21 0.57 4440 900 698 0.52 -0.06 0.49
pam lcs month 11 0 0.41 0.43 0.12 0.78 0.38 0.51 2.66 3938 684 552 175 168 147 103 102 75 72 22 0.55 0.37 0.24 0.41 0.14 -0.12 -0.16 0.02 -0.13 0.02 -0.02
pam lcs month 12 0 0.42 0.43 0.10 0.79 0.39 0.53 3.32 3924 682 538 180 171 115 90 89 86 77 65 21 0.53 0.37 0.34 0.31 0.14 -0.04 0.12 -0.12 0.01 -0.13 -0.18 -0.03
pam lcs month 13 0 0.42 0.43 0.10 0.80 0.40 0.53 3.36 3890 684 539 171 159 116 101 79 77 75 71 58 18 0.55 0.36 0.30 0.12 0.35 -0.05 0.04 -0.14 -0.18 0.18 -0.12 0.06 -0.02
pam lcs month 15 0 0.43 0.43 0.08 0.83 0.42 0.55 4.46 3830 676 519 170 158 113 101 75 74 74 71 58 53 48 18 0.55 0.39 0.39 0.13 0.33 -0.05 0.04 0.17 -0.13 -0.20 -0.12 -0.15 0.11 -0.10 -0.01
pam lcs month 12 1 0.42 0.43 0.10 0.80 0.39 0.52 3.36 3903 680 541 190 163 124 110 83 83 79 61 21 0.55 0.38 0.33 0.22 0.18 -0.08 -0.06 -0.16 -0.18 0.18 0.04 -0.02
pam lcs month 13 1 0.43 0.43 0.10 0.80 0.40 0.55 3.44 3904 678 539 189 163 120 111 81 80 79 71 18 5 0.54 0.39 0.34 0.21 0.17 -0.07 -0.06 -0.15 0.18 -0.09 -0.19 0.09 0.23
pam lcs month 14 1 0.43 0.43 0.09 0.82 0.41 0.55 3.92 3869 670 525 165 163 131 94 88 80 76 63 60 38 16 0.54 0.42 0.38 0.22 0.17 -0.08 0.10 0.05 -0.09 -0.14 -0.18 -0.15 -0.01 0.00
hac om month 12 0.40 0.42 0.15 0.67 0.34 0.49 1.79 3982 683 613 301 203 179 32 29 8 3 3 2 0.53 0.53 0.09 0.00 -0.23 0.36 -0.19 -0.11 0.34 0.44 0.23 0.75
hac om month 13 0.40 0.42 0.15 0.67 0.35 0.50 1.79 3982 683 613 265 203 179 36 32 29 8 3 3 2 0.53 0.53 0.08 0.10 -0.24 0.36 0.16 -0.20 -0.12 0.27 0.44 0.23 0.75
hac lcs month 5 0.46 0.42 0.13 0.78 0.27 0.42 2.76 4507 758 667 100 6 0.51 -0.13 0.49 -0.18 0.19
hac lcs month 6 0.46 0.42 0.13 0.78 0.28 0.45 2.76 4507 758 667 88 12 6 0.51 -0.13 0.49 -0.16 0.15 0.13
hac lcs month 7 0.46 0.42 0.13 0.78 0.29 0.47 2.76 4507 758 667 88 10 6 2 0.51 -0.13 0.49 -0.17 0.39 0.09 0.76
pam om month 4 1 0.33 0.42 0.25 0.56 0.25 0.26 0.74 4404 698 621 315 0.48 0.49 0.20 -0.14
pam lcs month 7 0 0.39 0.42 0.16 0.72 0.33 0.42 1.75 4067 687 649 235 169 126 105 0.50 0.39 0.32 -0.03 0.17 -0.02 -0.19
pam lcs month 10 0 0.39 0.42 0.14 0.74 0.36 0.49 2.06 4007 685 548 170 163 146 111 101 85 22 0.51 0.38 0.23 0.15 -0.18 0.54 -0.02 -0.14 0.17 -0.01
pam lcs month 8 1 0.39 0.42 0.15 0.72 0.34 0.48 1.87 4054 682 647 235 170 119 109 22 0.51 0.40 0.30 -0.02 0.16 0.01 -0.14 0.00
pam lcs month 9 1 0.39 0.42 0.14 0.74 0.35 0.48 2.06 3994 679 641 226 165 111 101 99 22 0.52 0.39 0.31 -0.04 0.17 -0.01 -0.14 0.03 -0.01
pam lcs month 10 1 0.39 0.42 0.14 0.74 0.36 0.49 2.06 4009 682 554 166 154 130 122 103 98 20 0.51 0.40 0.22 0.17 0.51 -0.14 -0.05 -0.15 0.10 0.01
hac lcs month 15 0.37 0.41 0.06 0.81 0.45 0.61 5.00 2635 1709 667 278 269 163 134 77 36 27 25 10 3 3 2 1.00 -0.21 0.30 -0.20 0.22 0.15 -0.16 0.03 -0.09 -0.05 -0.12 0.27 0.45 0.27 0.75
pam om month 2 0 0.16 0.41 0.48 0.39 0.12 0.11 0.13 5337 701 0.40 0.54
pam om month 2 1 0.16 0.41 0.48 0.39 0.12 0.11 0.13 5337 701 0.40 0.54
pam lcs month 6 0 0.38 0.41 0.17 0.69 0.31 0.37 1.54 4115 687 685 238 173 140 0.50 0.40 0.23 -0.05 0.16 -0.19
pam lcs month 8 0 0.39 0.41 0.15 0.71 0.34 0.43 1.85 4078 687 563 198 172 125 119 96 0.49 0.39 0.28 0.33 0.17 -0.14 -0.01 -0.20
pam lcs month 9 0 0.39 0.41 0.15 0.72 0.35 0.48 1.87 4066 686 553 171 169 146 120 105 22 0.50 0.39 0.22 0.16 -0.16 0.55 0.01 -0.13 -0.01
hac lcs month 12 0.37 0.40 0.08 0.78 0.41 0.58 3.61 2798 1709 667 412 269 77 63 25 10 3 3 2 0.89 -0.16 0.33 -0.22 0.23 0.04 -0.14 -0.11 0.30 0.45 0.30 0.76
hac lcs month 13 0.37 0.40 0.08 0.78 0.42 0.59 3.61 2798 1709 667 412 269 77 36 27 25 10 3 3 2 0.89 -0.16 0.33 -0.22 0.23 0.04 -0.06 -0.04 -0.11 0.27 0.45 0.27 0.76
hac lcs month 14 0.37 0.40 0.07 0.79 0.43 0.60 4.18 2798 1709 667 278 269 134 77 36 27 25 10 3 3 2 0.89 -0.16 0.33 -0.19 0.23 -0.15 0.03 -0.09 -0.05 -0.12 0.27 0.45 0.27 0.76
hac lcs month 10 0.36 0.39 0.08 0.77 0.40 0.54 3.46 2798 1709 667 412 346 63 25 10 6 2 0.89 -0.16 0.33 -0.19 0.04 -0.12 -0.11 0.36 0.07 0.76
hac lcs month 11 0.36 0.39 0.08 0.77 0.40 0.56 3.46 2798 1709 667 412 346 63 25 10 3 3 2 0.89 -0.16 0.33 -0.19 0.04 -0.12 -0.11 0.34 0.45 0.30 0.76
pam lcs month 5 0 0.37 0.39 0.19 0.65 0.28 0.35 1.27 4288 687 685 238 140 0.45 0.40 0.25 -0.05 -0.19
hac lcs month 8 0.35 0.38 0.10 0.74 0.37 0.50 2.59 2798 1709 758 667 88 10 6 2 0.89 -0.16 -0.16 0.33 -0.17 0.39 0.09 0.76
hac lcs month 9 0.35 0.38 0.10 0.74 0.38 0.52 2.59 2798 1709 758 667 63 25 10 6 2 0.89 -0.16 -0.16 0.33 -0.10 -0.11 0.37 0.07 0.76
pam lcs month 4 0 0.33 0.38 0.23 0.60 0.24 0.28 0.86 4368 719 693 258 0.44 0.20 0.38 -0.19
pam lcs month 3 0 0.26 0.36 0.30 0.52 0.19 0.18 0.45 4451 893 694 0.44 -0.09 0.40
pam lcs month 3 1 0.26 0.36 0.30 0.52 0.19 0.18 0.45 4451 893 694 0.44 -0.09 0.40
pam lcs month 4 1 0.34 0.33 0.22 0.61 0.26 0.31 0.94 4380 687 624 347 0.34 0.42 0.47 -0.24
pam lcs month 5 1 0.37 0.32 0.19 0.66 0.29 0.35 1.29 4288 681 570 348 151 0.32 0.42 0.57 -0.16 -0.21
pam lcs month 7 1 0.39 0.32 0.15 0.72 0.34 0.42 1.87 4067 681 502 386 166 129 107 0.33 0.41 0.70 -0.17 0.17 -0.04 -0.19
pam lcs month 6 1 0.38 0.29 0.17 0.69 0.31 0.40 1.54 4233 681 502 386 129 107 0.28 0.41 0.71 -0.17 -0.03 -0.19
Code
# hac   lcs month   3, pocos conglomerados, pero poco informativo
# pam   om  month   6   FALSO

Tiempo que demora esta sección: 0 minutos

Code
frobenius_norm(as.matrix(func_tab_range_clus(pamRange_quarter_lcs)), as.matrix(func_tab_range_clus(pamRange_quarter_lcs2)))

invisible("Frobenius norm: ||A-B||_F=\sqrt{\sum{i,j}(A_{ij}-B_ij)^2}")
invisible("Por ahora lo dejamos pasar, es para comparar matrices y sus diferencias")

Tiempo que demora esta sección: 0 minutos

La mayoría de las soluciones presentaron conglomerados con tamaños muy pequeños (n < 30), lo que limita su generalización y sugiere una estabilidad presumiblemente baja, o bien con valores ASW negativos, lo que añade evidencia a problemas de estabilidad de la solución.

Code
asw_month_qci$label<-with(asw_month_qci, paste0(algo, "_",type, "_", k, "_", ifelse(corr==1,1,ifelse(corr==0,0,0))))
plot(sort(asw_month_qci$ASW, decreasing = TRUE), 
     type = "b", 
     pch = 19, 
     xlab = "", 
     xaxt = "n",
     ylab = "Valor de ASW", 
     main = "", 
     col = "blue")
axis(1, at = 1:length(asw_month_qci$label), labels = asw_month_qci$label, las = 2, cex.axis = 0.60)
Gráfico de codo, ASW con etiquetas soluciones de conglomerados

Gráfico de codo, ASW con etiquetas soluciones de conglomerados

Tiempo que demora esta sección: 0 minutos

Se decidió por una solución de dos conglomerados que aunque tuvo valores globales en ASW subóptimos (0,41) y podría no ser del todo compleja, fue la única solución que obtuvo valores positvios en las medidas ASW por cada conglomerado, y sus conglomerados están integrados por más de 30 observaciones. A continuación, vemos los índices de calidad de la solución mediante remuestreos bootstrap con al menos 1,000 replicaciones.

Code
# results: hide
# fig.show: hide

opar <- par(no.readonly = TRUE)

#par(mfrow = c(2, 2)) # 2 filas, 2 columnas

#https://sequenceanalysis.org/2023/10/19/validating-sequence-analysis-typologies-using-parametric-bootstrap/

cbind.data.frame(
  algo= c(rep("PAM OM",2)),
  type= c(rep("Duración y secuencia",2),rep("Secuencia",2)),
  conglomerados= c("2","MaxT 95%"), rbind.data.frame(pam_om_month_null_comb_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")], pam_om_month_null_seq_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")]))%>% 
    { 
        rio::export(., "_output/sol_conglomerados_tab_m_validacion.xlsx")            
        knitr::kable(., "markdown", caption = "Validación CQIs conglomerados (mes)")
    }
Validación CQIs conglomerados (mes)
algo type conglomerados ASW HG PBC HC
1 PAM OM Duración y secuencia 2 0.41 0.39 0.16 0.48
16 PAM OM Duración y secuencia MaxT 95% [0.6; 0.62] [0.97; 0.98] [0.76; 0.78] [0.14; 0.16]
11 PAM OM Secuencia 2 0.41 0.39 0.16 0.48
161 PAM OM Secuencia MaxT 95% [0.38; 0.4] [0.57; 0.62] [0.31; 0.35] [0.29; 0.32]

Tiempo que demora esta sección: 0 minutos

Sólo los índices ASW y HC (C de Hubbert) mostraron mejores índices de calidad que los esperados para una estructura aleatoria en términos de secuencias.

A continuación se muestra el resultado de pruebas de validación mediante bootstraps.

Code
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_comb_m <- plot_grid(
  asw_grob_m, hc_grob_m, hg_grob_m, pbc_grob_m,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_comb_m, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Code
ggsave("_figs/pam_om_month_comb_qci.png", final_plot_comb_m, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

Code
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_m_seq <- plot_grid(
  asw_grob_seq_m, hc_grob_seq_m, hg_grob_seq_m, pbc_grob_seq_m,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_m_seq, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias aleatorias

Indicadores de calidad vs. bootstrap con secuencias aleatorias

Code
ggsave("_figs/pam_om_month_seq_qci.png", final_plot_m_seq, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

1. Trimestral

1.1. PAM (OM), sol 4 cluster- diagnósticos

Code
invisible("Información sobre la solución")
invisible("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/_hist_sintaxis/un_inv_ii5_explorar_soluciones.R")
# 
invisible("Hacemos clasificación de pertenencia cluster y ponemos etiquetas")
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4 <-
  factor(pamRange_quarter_om$clustering$cluster4,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster4)), "name")),
         labels= c("6035, Un trimestre, TSM(4)", "6025, Un trimestre, TUS(3)", "5939, Un semestre TSM(1)", "5989, Comorbilidad un trimestre(2)"))


invisible("Me da buena: 0,61 en promedio. El problema está con 5710 y 6036 que son pésimos")
sil_pam_om_clus4_q_nostd<-
  silhouette(as.integer(pamRange_quarter_om$clustering$cluster4), as.dist(dist_quarter_om))

# Crear etiquetas personalizadas
cluster_labels <- paste0("Cluster ", 
          seq_along(attr(summary(sil_pam_om_clus4_q_nostd)$clus.avg.widths, "dimnames")[[1]]), 
          ":\nAWS ", sprintf("%1.2f",summary(sil_pam_om_clus4_q_nostd)$clus.avg.widths))

# Graficar con etiquetas personalizadas
fviz_silhouette(
  sil_pam_om_clus4_q_nostd, 
  lab.clusters = cluster_labels, # Etiquetas personalizadas para los clústeres
  print.summary=F) +
  scale_fill_grey(start = 0.2, end = 0.8, labels = cluster_labels) +  # Escala de grises
  scale_color_grey(start = 0.2, end = 0.8, labels = cluster_labels)+   # Escala de grises para los bordea
  ggtitle(NULL)+
  labs(y="Ancho medio de la silueta", x="Conglomerados")# Elimina el título

Code
ggsave("_figs/sil_plot_pam_om4_q.png", width = 8, height = 5, dpi = 500)

Tiempo que demora esta sección: 0.3 minutos

Vemos los diagnósticos que vienen después de aquellos cluster con más de un ingreso.

Code
diag_pam_om4_5939<-
df_filled %>% 
  dplyr::filter(run %in% subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, clus_pam_om4=="5939, Un semestre TSM(1)")$run) %>% 
  dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) %>% 
  dplyr::group_by(run) %>%
  dplyr::filter(row_number() != 1) %>%  # Elimina la primera observación de cada run
  dplyr::mutate(
    all_diags = paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse = ", ")
  ) %>%
  dplyr::summarise(
    all_diags = first(all_diags),
    fecha_egreso_rec_fmt = first(fecha_egreso_rec_fmt),
    estab_homo = first(estab_homo)
  ) %>%
  dplyr::ungroup() %>% 
  dplyr::pull(all_diags) %>%  # Extraer la columna all_diags como vector
  strsplit(split = ", ") %>%  # Separar cada diagnóstico por comas
  unlist()  # Convertir la lista en un vector
invisible("head(arrange(data.frame(table(diag_pam_om4_5939)),-Freq),20)")
invisible("Para chatgpt= estos son códigos de CIE-10, descríbeme brevemente cada uno en markdown en formato 'Cód. CIE-10 (n=Freq) - [descripción] '")

# ggplot( head(arrange(data.frame(table(diag_pam_om4_5939)),-Freq),20), aes(x = reorder(diag_pam_om4_5939, -Freq), y = Freq)) +
#     geom_bar(stat = "identity", fill = "steelblue") +
#     labs(title = "Top 20 Most Frequent Diagnoses",
#          x = "Diagnosis",
#          y = "Frequency") +
#     theme(axis.text.x = element_text(angle = 45, hjust = 1))
#
# F329 (n=131) - Episodio depresivo no especificado  
# F603 (n=91) - Trastorno de la personalidad emocionalmente inestable, tipo límite  
# F609 (n=91) - Otros trastornos específicos de la personalidad  
# F322 (n=86) - Episodio depresivo grave sin síntomas psicóticos  
# F209 (n=62) - Esquizofrenia no especificada  
# F192 (n=51) - Trastornos mentales y del comportamiento debidos al uso de múltiples drogas y al uso de otras sustancias psicoactivas  
# F200 (n=45) - Esquizofrenia paranoide  
# F319 (n=43) - Trastorno depresivo recurrente, episodio actual no especificado  
# F432 (n=32) - Trastornos de adaptación  
# Z915 (n=31) - Antecedentes personales de traumatismo no clasificado en otra parte  
# C490 (n=29) - Neoplasia maligna del tejido conectivo y de los tejidos blandos, de localización no especificada  
# G909 (n=29) - Trastorno del sistema nervioso no especificado  
# F323 (n=27) - Episodio depresivo grave con síntomas psicóticos  
# F431 (n=27) - Reacción al estrés agudo y trastornos de adaptación  
# F29X (n=21) - Psicosis no orgánica no especificada  
# Z511 (n=20) - Atención sanitaria para radioterapia  
# F419 (n=18) - Trastorno de ansiedad no especificado  
# F608 (n=16) - Otros trastornos específicos de la personalidad  
# F239 (n=14) - Trastorno psicótico agudo y transitorio no especificado  
# F449 (n=14) - Trastorno de ansiedad fóbica no especificado  

Tiempo que demora esta sección: 0 minutos

Entre quienes se encuentren en un semestre en el sistema por TSM y presentan un segundo episodio, de las 20 condiciones más frecuentes, al menos el 50% se caracteriza por episodios depresivos no especificado (F329), trastornos de la personalidad tipo límite (F603), otros trastornos específicos de la personalidad (F609) y episodios depresivos graves sin síntomas psicóticos (F322) y esquizofrenia no especificada (F209).

Luego vemos la clasificación de PPOO por cluster

Code
janitor::chisq.test(df_filled[,c("run","glosa_pueblo_originario")] %>% 
        dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run", "clus_pam_om4")], by="run", multiple="first") %>% 
        janitor::tabyl(glosa_pueblo_originario, clus_pam_om4))

    Pearson's Chi-squared test

data:  df_filled[, c("run", "glosa_pueblo_originario")] %>% dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,     c("run", "clus_pam_om4")], by = "run", multiple = "first") %>%     janitor::tabyl(glosa_pueblo_originario, clus_pam_om4)
X-squared = 136.81, df = 24, p-value < 2.2e-16
Code
# X-squared = 136.81, df = 24, p-value < 2.2e-16

invisible("No exclusivo de la clasificación por conglomerados, sino de las trayectorias en general y las matrices de distancia")
#https://cran.r-project.org/web/packages/TraMineRextras/TraMineRextras.pdf
seqcompare_sex_quarter_om<-
seqCompare(States_Wide.seq_quarter_t_prim_adm, group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$glosa_sexo, method="OM", sm=costmatrix_quarter, seed= 2125, s=1e1, stat="all")
#           LRT    p-value BIC diff. Bayes Factor (Avg) Bayes Factor (From Avg BIC)
# [1,] 3.723906 0.07729539 0.7281733           2.140152                    1.439199
seqcompare_sex_quarter_lcs<-
seqCompare(States_Wide.seq_quarter_t_prim_adm, group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$glosa_sexo, method="LCS", sm=costmatrix_quarter, seed= 2125, s=1e1, stat="all")
#           LRT    p-value BIC diff. Bayes Factor (Avg) Bayes Factor (From Avg BIC)
# [1,] 3.537305 0.08879071 0.5415731           2.120956                    1.310995

seqcompare_ppoo_quarter_om<-
seqCompare(States_Wide.seq_quarter_t_prim_adm, group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$inclusivo_real_historico, method="OM", sm=costmatrix_quarter, seed= 2125, s=1e1, stat="all")
#  Currently seqLRT supports only 2 groups!
#           LRT    p-value BIC diff. Bayes Factor (Avg) Bayes Factor (From Avg BIC)
# [1,] 3.321524 0.08714022  0.325792           1.479436                    1.176914
seqcompare_ppoo_quarter_lcs<-
seqCompare(States_Wide.seq_quarter_t_prim_adm, group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$inclusivo_real_historico, method="LCS", sm=costmatrix_quarter, seed= 2125, s=1e1, stat="all")
#           LRT    p-value BIC diff. Bayes Factor (Avg) Bayes Factor (From Avg BIC)
# [1,] 3.214252 0.09793892   0.21852           1.456759                    1.115452

Tiempo que demora esta sección: 0 minutos

Generamos un gráfico de PPOO por cada conglomerado.

Code
ppoo_clus_pre_pam_om4_q<-
  df_filled[,c("run","glosa_pueblo_originario")] %>% 
  dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run", "clus_pam_om4","factor_inclusivo_real_hist_mas_autperc")], by="run", multiple="first") %>% 
  dplyr::mutate(glosa_pueblo_originario_rec= dplyr::case_when(glosa_pueblo_originario=="NINGUNO" & factor_inclusivo_real_hist_mas_autperc!="00"~ "DESCONOCIDO", T~glosa_pueblo_originario)) %>% 
  janitor::tabyl(glosa_pueblo_originario_rec, clus_pam_om4) %>% 
  janitor::adorn_percentages("row")

reshape2::melt(ppoo_clus_pre_pam_om4_q, id.vars = "glosa_pueblo_originario_rec") %>% 
  dplyr::mutate(glosa_pueblo_originario_rec= 
    dplyr::recode(glosa_pueblo_originario_rec, 
      "OTRO (ESPECIFICAR)"="OTRO(n=77)", 
      "RAPA NUI (PASCUENSE)"="RAPA NUI(n=34)", 
      "YAGÁN (YÁMANA)"="YAGÁN(n=2)",
      "AYMARA"="AYMARA(n=13)",
      "COLLA"="COLLA(n=6)",
      "DIAGUITA"="DIAGUITA(n=3)",
      "KAWÉSQAR"="KAWÉSQAR(n=4)",
      "MAPUCHE"="MAPUCHE(n=255)",
      "DESCONOCIDO"=".DESCONOCIDO(n=1.985)",
      "NINGUNO"=".NINGUNO(n=9.156)")) %>% 
ggplot(aes(x = glosa_pueblo_originario_rec, y = value, fill = variable)) + 
  geom_bar(stat = "identity", position = "fill") + 
  scale_fill_manual(values = c("#D2B48C", "#E27A5B", "#708090", "#6B8E23")) +
  labs(title = NULL,
       x = "Grupo Étnico",
       y = "Proporción de Casos",
       fill = "Grupos") +  # Cambia el título de la leyenda a "Grupos"
  theme_minimal() +
  theme(
    axis.text.y = element_text(size = 12),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 12),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 14),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 14),          # Tamaño del título del eje Y
    plot.title = NULL,  # Tamaño y estilo del título del gráfico
    legend.title = element_text(size = 14, margin = margin(b = -.1)),          # Tamaño del título de la leyenda
    legend.spacing.y = unit(1.5, "lines"),
    legend.box.spacing = unit(0.5, "lines"),      # Controla el espacio entre la leyenda y el gráfico
    legend.margin = margin(5, 5, 5, 5),  
    legend.key.height = unit(1, "cm"),  
    legend.text = element_text(size = 12)            # Tamaño del texto de la leyenda
    ) + 
  coord_flip()  # Hacer el gráfico horizontal
ggsave("_figs/grafico_ancho_achatado_pam_om4_q.png", width = 10, height = 5, dpi=1000)
PPOO por cluster

PPOO por cluster

Tiempo que demora esta sección: 0 minutos

1.1.1. Trayectorias

Vemos los gráficos de las trayectorias

Code
categories_pam_om4_q<-attr(States_Wide.seq_quarter_t_prim_adm_cens, "labels")
new_labels <- categories_pam_om4_q
new_labels[which(categories_pam_om4_q == "Otras causas")] <- "Otras\ncausas"
#new_labels[which(categories == "Consumo\nde sustancias")] <- "Consumo de\nsustancias"

# Creamos un vector con las columnas llenando con NA si faltan valores
sil_pam_om_clus4_q <- wcSilhouetteObs(as.dist(dist_quarter_om), 
        pamRange_quarter_om$clustering$cluster4, measure="ASW")


seq_plot_pam_om4_q <- ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,
                                 facet_ncol=2, facet_nrow=2, sortv=sil_pam_om_clus4_q) +
  theme(legend.position = "none")+
  labs(x="Trimestres", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_pam_om4_q 

ggsave(filename="_figs/clusters_pam_om4_q_mod.png", seq_plot_pam_om4_q,  width = 9.5, height = 5.5, dpi=1000)
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.3 minutos

Code
seq_plot2_pam_om4_q <- ggseqdplot(States_Wide.seq_quarter_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,
                                 facet_ncol=2, facet_nrow=2) +
  theme(legend.position = "none")+  # Colocar la leyenda abajo
  labs(x="Trimestres", y="Frecuencia relativa de estados")+
  theme(
    panel.spacing = unit(0.1, "lines"),
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -5)),
    strip.text = element_text(size = 11),
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda    
  )  # Colocar la leyenda abajo
seq_plot2_pam_om4_q
ggsave("_figs/clusterspam_om42_q_mod.png",seq_plot2_pam_om4_q, width = 8.5, height = 5.5, dpi=1000)


table_data_pam_om4_q <- sprintf("%1.2f",pamRange_quarter_om$stats[3,])
table_data_pam_om4_q <-as.data.frame(t(table_data_pam_om4_q))
colnames(table_data_pam_om4_q)<-attr(pamRange_quarter_om$stats, "name")
table_data_pam_om4_q %>% knitr::kable()
PBC HG HGSD ASW ASWw CH R2 CHsq R2sq HC
0.50 0.67 0.67 0.60 0.60 922.92 0.31 1269.60 0.39 0.18

Trayectorias de hospitalización, frecuencia relativa de estados en un gráfico de barras apiladas por trimestre.

Trayectorias de hospitalización, frecuencia relativa de estados en un gráfico de barras apiladas por trimestre.

Trayectorias de hospitalización, frecuencia relativa de estados en un gráfico de barras apiladas por trimestre.

Tiempo que demora esta sección: 0.1 minutos

De este modo, presenta el cambio agregado en la distribución de estados a lo largo del tiempo, sin considerar las secuencias individuales.

Code
invisible("Definimos las observaciones que tienen siluetas negativas")
sil_neg_pam_om_clus4_q <- which(sil_pam_om_clus4_q<0)

invisible("A qué conglomerados pertenecen?")
table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[sil_neg_pam_om_clus4_q, "clus_pam_om4"])

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$rn<- 1:nrow(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens)
clus_pam_om4
        6035, Un trimestre, TSM(4)         6025, Un trimestre, TUS(3)           5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2) 
                                 2                                  0                                133                                  0 

Tiempo que demora esta sección: 0 minutos

1.1.2.Exploración transiciones

1.1.2.a Transiciones- RM y no RM

Tasas de transición no RM a RM y viceversa

Code
invisible("Tasas de transición no RM a RM y viceversa")

trim_tasa_pam_om4_q_cens_cnt<-  
  seqcount_t(States_Wide.seq_quarter_t_prim_adm_RM_cens, 
             group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 
trim_tasa_pam_om4_q_cens_rate<-  
  seqtrate_t(States_Wide.seq_quarter_t_prim_adm_RM_cens, 
             group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))

Tiempo que demora esta sección: 0 minutos

Code
trim_tasa_pam_om4_q_cens_rate %>%   
  dplyr::left_join(trim_tasa_pam_om4_q_cens_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  dplyr::filter(from %in% c("RM", "noRM")) %>%  
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")

invisible("Hay muy pocos casos que se entrecruzan entre noRM y RM (fuera de la diagnonal)")
Porcentajes de transición no-RM y RM por cada cluster

Porcentajes de transición no-RM y RM por cada cluster

Tiempo que demora esta sección: 0.1 minutos

Hay muy pocos casos que se entrecruzan entre noRM y RM (fuera de la diagnonal)

1.1.2.b Transiciones
Code
trim_tasa2_pam_om4_q_cens_cnt<-  
   seqcount_t(States_Wide.seq_quarter_t_prim_adm_cens, 
             group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4) %>% 
  dplyr::filter(count>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .))) 
trim_tasa2_pam_om4_q_cens_rate<-  
  seqtrate_t(States_Wide.seq_quarter_t_prim_adm_cens, 
             group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4) %>% 
  dplyr::filter(rate>0) %>% 
  dplyr::mutate(trans = paste0(from,"_", to)) %>% 
  dplyr::mutate(across(c("from","to"),~  gsub("\\[->\\s*|\\s*->\\s*\\]|\\[|\\]", "", .)))

Tiempo que demora esta sección: 0 minutos

Code
trim_tasa2_pam_om4_q_cens_rate %>%   
  dplyr::left_join(trim_tasa2_pam_om4_q_cens_cnt, by=c("from"="from", "glosa_sexo"="glosa_sexo","to"="to")) %>% 
  dplyr::rename("recuento"="count") %>% 
  #dplyr::filter(from %in% c("RM", "noRM")) %>%  
  ggplot(aes(x = from, y = to, fill = rate, size=log(recuento+1))) +
  geom_tile() +
  coord_flip()+
  scale_fill_gradient(low = "white", high = "blue") + # Ajusta la escala de colores según tus preferencias
  labs(title = "Tasas de transición, Trimestre (s/censura)",
       x = "Desde",
       y = "Hacia",
       fill = "Rate") +
  theme_minimal() +
  facet_wrap(~glosa_sexo)+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  geom_text(aes(label = sprintf("%1.2f", rate), size =log(recuento+1)*.5), color = "black")
Porcentajes de transición, transiciones posteriores, por cada cluster

Porcentajes de transición, transiciones posteriores, por cada cluster

Tiempo que demora esta sección: 0.1 minutos

1.1.2.c Tiempo promedio por cluster
Code
seq_mean_t(States_Wide.seq_quarter_t_prim_adm_cens, 
             group=ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4) %>% 
  data.table::as.data.table(keep.rowname=T) %>%
  dplyr::mutate(rn= gsub("\\d", "", rn)) |> 
  ggplot(aes(x=rn, fill= factor_inclusivo, y=Mean))+
  geom_bar(width = 1, stat = "identity") +
  theme_minimal() +
  facet_wrap(~factor_inclusivo)+
  labs(title = NULL,
       x = NULL,
       y = NULL) +
  scale_fill_manual(values = c("#70809090", "#6B8E2380", "#E27A5B","#D2B48C")) +
  coord_flip()+
  theme(#axis.text.x = element_blank(),
    #axis.text.y = element_blank(),
    panel.grid = element_blank()) +
#  scale_fill_brewer(palette = "Pastel1", labels=c("Sin\nautoidentificación\nni reconocimiento", "Autoidentificación\nsin reconocimiento", "Ambas")) +
  geom_text(aes(label = round(Mean,1)), 
            position = position_stack(vjust = 0.5), 
            size = 3.5, # Ajusta el tamaño de la fuente aquí
            color = "black", # Color del texto
            family = "sans", # Puedes cambiar la fuente si lo deseas
            background = element_rect(fill = "white", color = NA)) + # Fondo blanco
  theme(legend.title = element_blank())

invisible("No me aporta mucho")
Tiempo promedio en cada estado por estatus PPOO (Trimestral c/censura)

Tiempo promedio en cada estado por estatus PPOO (Trimestral c/censura)

Tiempo que demora esta sección: 0.1 minutos

Observamos que aquellos en el conglomerado que se encuentra un trimestre, la duración de los ingresos relacionados con trastornos de salud mental son en promedio más largos.

1.1.3. Comparación variables

1.1.3.a. Comparación covariables- PPOO
Code
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>%
  dplyr::count(clus_pam_om4, factor_inclusivo_real_hist_mas_autperc) %>%
  dplyr::group_by(clus_pam_om4) %>%
  dplyr::mutate(n_prop = paste0(n, " (",scales::percent(n / sum(n)),")")) %>%
  dplyr::select(-n) %>%
  tidyr::pivot_wider(names_from = factor_inclusivo_real_hist_mas_autperc, values_from = n_prop, values_fill = "0") %>% 
  knitr::kable("markdown", col.names=c("Conglomerados","No se identifica/no pertenece", "No se identifica/hay reconocimiento", "Se identifica/hay reconocimeinto"), caption="Porcentajes por fila, conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO")

invisible("6025 tiwnw un poxo mas PPOO, lo mismo con 5710")
Porcentajes por fila, conglomerado vs. Pertenencia/identificación + Reconocimento CONADI PPOO
Conglomerados No se identifica/no pertenece No se identifica/hay reconocimiento Se identifica/hay reconocimeinto
6035, Un trimestre, TSM(4) 3857 (80.6%) 536 (11.2%) 395 (8.2%)
6025, Un trimestre, TUS(3) 537 (78.5%) 79 (11.5%) 68 (9.9%)
5939, Un semestre TSM(1) 291 (82.2%) 39 (11.0%) 24 (6.8%)
5989, Comorbilidad un trimestre(2) 178 (83.96%) 18 (8.49%) 16 (7.55%)

Tiempo que demora esta sección: 0 minutos

Vemos las categorías de clasificación de PPOO según autopercepción (en MINSAL y en RSH) y reconocimiento CONADI.

Code
chisq.test(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc,ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4))
#X-squared = 5.5844, df = 6, p-value = 0.4713

message("Descartando valores negativos en sil width")
chisq.test(
with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q), table(factor_inclusivo_real_hist_mas_autperc, clus_pam_om4))
)

    Pearson's Chi-squared test

data:  table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc,     ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4)
X-squared = 5.5844, df = 6, p-value = 0.4713


    Pearson's Chi-squared test

data:  with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens,     !rn %in% sil_neg_pam_om_clus4_q), table(factor_inclusivo_real_hist_mas_autperc,     clus_pam_om4))
X-squared = 7.1377, df = 6, p-value = 0.3083

Tiempo que demora esta sección: 0 minutos

Ahora lo hacemos con la versión binarizada

Code
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc_bin<- ifelse(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$factor_inclusivo_real_hist_mas_autperc=="00",0,1)

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
    dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% 
    janitor::tabyl(factor_inclusivo_real_hist_mas_autperc_bin,clus_pam_om4) %>%
    janitor::chisq.test()
#X-squared = 4.0105, df = 3, p-value = 0.2603
#
#
message("Descartando valores negativos en sil width")
chisq.test(
with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q), table(pueblo_originario_01 , clus_pam_om4))
)

    Pearson's Chi-squared test

data:  .
X-squared = 4.0105, df = 3, p-value = 0.2603


    Pearson's Chi-squared test

data:  with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens,     !rn %in% sil_neg_pam_om_clus4_q), table(pueblo_originario_01,     clus_pam_om4))
X-squared = 2.5145, df = 3, p-value = 0.4727

Tiempo que demora esta sección: 0 minutos

Hicimos una prueba post-hoc usando Bonferroni

1.1.3.b. Comparación covariables- Mortalidad
Code
# 
invisible("No hay nada, el tiempo promedio de censura es similar")

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% 
  janitor::tabyl(clus_pam_om4,death_time_rec) %>% 
  dplyr::mutate(`1`= paste0(`1`," (", scales::percent(`1`/(`0`+`1`), accuracy=.1),")")) %>% 
  dplyr::left_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::group_by(clus_pam_om4) %>% 
  dplyr::summarise(mean=sprintf("%1.1f",mean(cens_time))), by="clus_pam_om4") %>% 
  dplyr::select(-`0`) %>% 
  knitr::kable("markdown", col.names=c("Conglomerado","Mortalidad observada", "Promedio"), caption="Post-hoc, conglomerado vs. Mortalidad y tiempo a censura")
Post-hoc, conglomerado vs. Mortalidad y tiempo a censura
Conglomerado Mortalidad observada Promedio
6035, Un trimestre, TSM(4) 45 (0.9%) 17.9
6025, Un trimestre, TUS(3) 13 (1.9%) 18.2
5939, Un semestre TSM(1) 8 (2.3%) 18.0
5989, Comorbilidad un trimestre(2) 4 (1.9%) 18.1

Tiempo que demora esta sección: 0 minutos

Code
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
             dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% 
             janitor::tabyl(death_time_rec,clus_pam_om4) %>% 
              janitor::chisq.test(correct=T)
#X-squared = 10.014, df = 3, p-value = 0.01845

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
             dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) %>% 
             janitor::tabyl(death_time_rec,clus_pam_om4) %>% 
              janitor::fisher.test(simulate.p.value=T, B=1e5)
#p-value = 0.01242

message("Descartando valores negativos en sil width")
chisq_cramerv(
with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q)%>% 
             dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)), table(death_time_rec , clus_pam_om4))
)

invisible("no se basa en la distribución chi-cuadrado. Fisher se basa en permutaciones exactas, por lo que no se calculan df.")

#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
##_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
tab_cl_mortalidad_pam_om4_q<- 
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::mutate(death_time_rec=ifelse(death_time==20,0,1)) |> 
  janitor::tabyl(death_time_rec,clus_pam_om4) |> 
  as.matrix(ncol=2)

labels_pam_om4_q <- c(
  "6035, Un trimestre, TSM(4)",
  "6025, Un trimestre, TUS(3)",
  "5939, Un semestre TSM(1)",
  "5989, Comorbilidad un trimestre(2)"
)

# Realizar el análisis y crear la tabla directamente
pairwise.prop.test(t(tab_cl_mortalidad_pam_om4_q[,2:5]), p.adjust.method = "holm")$p.value |>
  as.table() |>
  as.data.frame() |>
  rename(Grupo_1 = Var1, Grupo_2 = Var2, p_value = Freq) |>
  filter(!is.na(p_value)) |>
  mutate(
    Grupo_1 = labels_pam_om4_q[as.numeric(Grupo_1)],
    Grupo_2 = labels_pam_om4_q[as.numeric(Grupo_2)],
    p_value = ifelse(p_value <.001, "<.001", sprintf("%1.3f",p_value)) 
  ) |>
  kable(
    col.names = c("Grupo 1", "Grupo 2", "Valor p ajustado"),
    align = "l",
    caption= "Corrección parcial por comparaciones múltiples (Holm–Bonferroni)"
  )

    Pearson's Chi-squared test

data:  .
X-squared = 10.014, df = 3, p-value = 0.01845


    Fisher's Exact Test for Count Data with simulated p-value (based on 1e+05 replicates)

data:  .
p-value = 0.01168
alternative hypothesis: two.sided

$chisq_statistic
[1] "8.76"

$chisq_df
df 
 3 

$chisq_p_value
[1] "0.0326"

$cramers_v
[1] "0.04"
Corrección parcial por comparaciones múltiples (Holm–Bonferroni)
Grupo 1 Grupo 2 Valor p ajustado
6035, Un trimestre, TSM(4) 6035, Un trimestre, TSM(4) 0.214
6025, Un trimestre, TUS(3) 6035, Un trimestre, TSM(4) 0.214
5939, Un semestre TSM(1) 6035, Un trimestre, TSM(4) 1.000
6025, Un trimestre, TUS(3) 6025, Un trimestre, TUS(3) 1.000
5939, Un semestre TSM(1) 6025, Un trimestre, TUS(3) 1.000
5939, Un semestre TSM(1) 5939, Un semestre TSM(1) 1.000

Tiempo que demora esta sección: 0 minutos

1.1.3.c. Comparación covariables- no RM vs. RM
Code
chisq_cramerv(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$codigo_region_rec_base))
# $chisq_statistic
# [1] "38.64"
# 
# $chisq_df
# df 
#  3 
# 
# $chisq_p_value
# [1] "<0.001"
# 
# $cramers_v
# [1] "0.08"

message("Descartando valores negativos en sil width")
chisq_cramerv(
with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q), table(codigo_region_rec_base , clus_pam_om4))
)


table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$codigo_region_rec_base) %>% 
    data.frame() |>  
    dplyr::group_by(Var1) |> 
    dplyr::mutate(perc= scales::percent(Freq/sum(Freq), accuracy=1)) |> 
    dplyr::ungroup() |> 
    dplyr::mutate(Freq= Freq)  |>
    dplyr::mutate(fp= paste0(Freq, " (", perc,")" )) |> 
    dplyr::select(-Freq, -perc) |> 
    tidyr::pivot_wider(names_from="Var2",values_from="fp")  |> 
  knitr::kable("markdown", caption="Frecuencias absolutas y relativas por fila", col.names= c("Conglomerados", "Fuera de RM", "En RM"))
$chisq_statistic
[1] "38.64"

$chisq_df
df 
 3 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.08"

$chisq_statistic
[1] "36.97"

$chisq_df
df 
 3 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.08"
Frecuencias absolutas y relativas por fila
Conglomerados Fuera de RM En RM
6035, Un trimestre, TSM(4) 2561 (53%) 2227 (47%)
6025, Un trimestre, TUS(3) 433 (63%) 251 (37%)
5939, Un semestre TSM(1) 178 (50%) 176 (50%)
5989, Comorbilidad un trimestre(2) 89 (42%) 123 (58%)

Tiempo que demora esta sección: 0 minutos

Al parecer, el conglomerado 6025, Un trimestre, TUS(3) tendría una proporción significativamente mayor que el resto de pacientes fuera de la RM, aunque con una fuerza de asociación débil. En contraste, el conglomerado 5989, Comorbilidad un trimestre(2) tiene una proporción mayor de personas en la RM a diferencia de 6025, Un trimestre, TUS(3) y 6035, Un trimestre, TSM(4).

Code
pairwise_chisq_gof_test(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$codigo_region_rec_base), p.adjust.method="holm")|> 
  knitr::kable("markdown", caption="Dependencia categórica sol. 4 conglomerados, por pares de categorías en RM")
Dependencia categórica sol. 4 conglomerados, por pares de categorías en RM
n group1 group2 statistic p df p.adj p.adj.signif
2 grp1 grp2 1512.4863059 0.00e+00 1 0.00e+00 ****
2 grp1 grp3 2073.2709018 0.00e+00 1 0.00e+00 ****
2 grp1 grp4 2305.9562264 0.00e+00 1 0.00e+00 ****
2 grp1 grp5 23.2990810 1.40e-06 1 9.70e-06 ****
2 grp1 grp6 1897.6173542 0.00e+00 1 0.00e+00 ****
2 grp1 grp7 2078.2700037 0.00e+00 1 0.00e+00 ****
2 grp1 grp8 2214.5469449 0.00e+00 1 0.00e+00 ****
2 grp2 grp3 106.4238953 0.00e+00 1 0.00e+00 ****
2 grp2 grp4 226.6973180 0.00e+00 1 0.00e+00 ****
2 grp2 grp5 1209.9383459 0.00e+00 1 0.00e+00 ****
2 grp2 grp6 48.4269006 0.00e+00 1 0.00e+00 ****
2 grp2 grp7 108.4548440 0.00e+00 1 0.00e+00 ****
2 grp2 grp8 172.8417266 0.00e+00 1 0.00e+00 ****
2 grp3 grp4 29.6666667 1.00e-07 1 5.00e-07 ****
2 grp3 grp5 1745.6968815 0.00e+00 1 0.00e+00 ****
2 grp3 grp6 12.4219114 4.24e-04 1 2.12e-03 **
2 grp3 grp7 0.0112994 9.15e-01 1 9.15e-01 ns
2 grp3 grp8 10.0498339 1.52e-03 1 6.08e-03 **
2 grp4 grp5 1973.6804836 0.00e+00 1 0.00e+00 ****
2 grp4 grp6 77.1882353 0.00e+00 1 0.00e+00 ****
2 grp4 grp7 28.5622642 1.00e-07 1 7.00e-07 ****
2 grp4 grp8 5.4528302 1.95e-02 1 3.90e-02 *
2 grp5 grp6 1575.6965295 0.00e+00 1 0.00e+00 ****
2 grp5 grp7 1750.5622139 0.00e+00 1 0.00e+00 ****
2 grp5 grp8 1883.7514894 0.00e+00 1 0.00e+00 ****
2 grp6 grp7 13.1733021 2.84e-04 1 1.70e-03 **
2 grp6 grp8 43.8074866 0.00e+00 1 0.00e+00 ****
2 grp7 grp8 9.3946488 2.18e-03 1 6.54e-03 **

Tiempo que demora esta sección: 0 minutos

Code
chisq.posthoc.test(
table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$codigo_region_rec_base)
) %>% 
  dplyr::mutate_at(3:ncol(.), ~round(as.numeric(gsub("\\*","",.)),3)) %>% 
  #knitr::kable("html", caption="Comparación post-hoc, conglomerado-región")%>%
  group_by(Dimension) %>%
  summarise(across(2:(ncol(.)-1),
                   ~ paste0(first(sprintf("%1.2f",.)), " (p=", last(sprintf("%1.3f",.)), ")"))) %>%
  dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=0.000)","p<0.001)",.)) %>% 
  #dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=1)","p=1.000)",.)) %>% 
  #dplyr::mutate(Dimension= tab_clus_macrozona_pam_om4_q[1]) %>% 
  knitr::kable("markdown", caption="Comparación post-hoc, conglomerado-RM vs. No-RM")
Comparación post-hoc, conglomerado-RM vs. No-RM
Dimension noRM RM
5939, Un semestre TSM(1) -1.45 (p=1.000) 1.45 (p=1.000)
5989, Comorbilidad un trimestre(2) -3.58 (p=0.003) 3.58 (p=0.003)
6025, Un trimestre, TUS(3) 5.18 (p<0.001) -5.18 (p<0.001)
6035, Un trimestre, TSM(4) -1.59 (p=0.900) 1.59 (p=0.900)

Tiempo que demora esta sección: 0 minutos

De la tabla anterior, se observa que participantes pertenecientes al conglomerado “6025, Un trimestre, TUS(3)” presenta una menor proporción de residentes de la Región Metropolitana. Por otra parte, participantes pertenecientes al conglomerado ” 5989, Comorbilidad un trimestre(2)” pertenecen en mayor proporción a la RM.

1.1.3.e. Comparación covariables- Región
Code
tab_cluster_region_pam_om4_q<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], 
                    by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first") %>% 
  janitor::tabyl(codigo_region, clus_pam_om4) %>% 
  janitor::adorn_percentages("col") %>% 
  janitor::adorn_rounding(digits = 2)

#colnames(tab_cluster_region_pam_om4_q)<- c("reg", "c1", "c4", "c3", "c5", "c6", "c7", "c8", "c9", "c2")
cod_reg_homo_pam_om4_q<-
data.frame(
  codigo_region = 1:16,
  nombre_region = c(
    "Región de Tarapacá",
    "Región de Antofagasta",
    "Región de Atacama",
    "Región de Coquimbo",
    "Región de Valparaíso",
    "Región del Libertador General Bernardo O'Higgins",
    "Región del Maule",
    "Región del Biobío",
    "Región de La Araucanía",
    "Región de Los Lagos",
    "Región de Aysén del General Carlos Ibáñez del Campo",
    "Región de Magallanes y de la Antártica Chilena",
    "Región Metropolitana de Santiago",
    "Región de Los Ríos",
    "Región de Arica y Parinacota",
    "Región de Ñuble"
  ),
  stringsAsFactors = FALSE
)

dplyr::mutate(tab_cluster_region_pam_om4_q, promedio_fila = rowMeans(across(2:length(colnames(tab_cluster_region_pam_om4_q))))) %>% 
  dplyr::arrange(desc(promedio_fila)) %>% 
  dplyr::left_join(cod_reg_homo_pam_om4_q, by="codigo_region") %>% 
  dplyr::select(codigo_region, nombre_region, everything()) %>% 
  dplyr::select(-promedio_fila) %>% 
  dplyr::mutate_at(3:(length(colnames(tab_cluster_region_pam_om4_q))+1),~scales::percent(.)) %>% 
  knitr::kable(caption="Porcentaje por región")
Porcentaje por región
codigo_region nombre_region 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
13 Región Metropolitana de Santiago 45% 35% 47% 56%
10 Región de Los Lagos 6% 20% 5% 10%
5 Región de Valparaíso 8% 13% 11% 6%
8 Región del Biobío 10% 8% 9% 9%
9 Región de La Araucanía 5% 4% 5% 4%
6 Región del Libertador General Bernardo O’Higgins 4% 3% 5% 2%
7 Región del Maule 4% 3% 3% 4%
2 Región de Antofagasta 2% 1% 4% 1%
11 Región de Aysén del General Carlos Ibáñez del Campo 2% 2% 1% 3%
14 Región de Los Ríos 3% 3% 2% 0%
16 Región de Ñuble 2% 2% 3% 1%
12 Región de Magallanes y de la Antártica Chilena 1% 2% 3% 1%
1 Región de Tarapacá 2% 1% 1% 2%
3 Región de Atacama 2% 1% 2% 0%
4 Región de Coquimbo 1% 1% 1% 0%
15 Región de Arica y Parinacota 2% 0% 1% 0%

Tiempo que demora esta sección: 0 minutos

Code
tab_clus_reg_pam_om4_q<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
    dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], 
                      by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first") %>% 
    janitor::tabyl(codigo_region, clus_pam_om4)

chisq_cramerv(tab_clus_reg_pam_om4_q[,-1])
# $chisq_statistic
# [1] "243.65"
# 
# $chisq_df
# df 
# 45 
# 
# $chisq_p_value
# [1] "<0.001"
# 
# $cramers_v
# [1] "0.12"
janitor::fisher.test(tab_clus_reg_pam_om4_q, simulate.p.value=T, B=1e5)
#p-value = 1e-05

message("Descartando valores negativos en sil width")
chisq_cramerv(
with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q)%>% 
    dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first") , table(codigo_region , clus_pam_om4))
)
$chisq_statistic
[1] "243.65"

$chisq_df
df 
45 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.12"


    Fisher's Exact Test for Count Data with simulated p-value (based on 1e+05 replicates)

data:  tab_clus_reg_pam_om4_q
p-value = 1e-05
alternative hypothesis: two.sided

$chisq_statistic
[1] "244.74"

$chisq_df
df 
45 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.12"

Tiempo que demora esta sección: 0 minutos

Se encuentra una asociación significativa aunque débil.

Por macrozona

Code
tab_clus_macrozona_pam_om4_q<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], 
                    by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first") %>% 
dplyr::mutate(macrozona = dplyr::case_when(
  codigo_region %in% c(15, 1, 2, 3) ~ "Macrozona Norte",
  codigo_region %in% c(4, 5)~ "Macrozona Centro",
  codigo_region %in% c(6, 7, 16, 8) ~ "Macrozona Centro Sur",
  codigo_region %in% c(9, 14, 10) ~ "Macrozona Sur",
  codigo_region %in% c(11, 12) ~ "Macrozona Austral",
  TRUE ~ "RM"  # En caso de que algún código no esté especificado
)) %>% 
  janitor::tabyl(macrozona, clus_pam_om4) 

chisq_cramerv(tab_clus_macrozona_pam_om4_q[,-1])
# $chisq_statistic
# [1] "125.88"
# 
# $chisq_df
# df 
# 15 
# 
# $chisq_p_value
# [1] "<0.001"
# 
# $cramers_v
# [1] "0.08"
#

message("Descartando valores negativos en sil width")
chisq_cramerv(
with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q)%>% 
  dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], 
                    by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first") %>% 
dplyr::mutate(macrozona = dplyr::case_when(
  codigo_region %in% c(15, 1, 2, 3) ~ "Macrozona Norte",
  codigo_region %in% c(4, 5)~ "Macrozona Centro",
  codigo_region %in% c(6, 7, 16, 8) ~ "Macrozona Centro Sur",
  codigo_region %in% c(9, 14, 10) ~ "Macrozona Sur",
  codigo_region %in% c(11, 12) ~ "Macrozona Austral",
  TRUE ~ "RM"  # En caso de que algún código no esté especificado
)) , table(macrozona, clus_pam_om4))
)

tab_clus_macrozona_pam_om4_q%>% 
  janitor::adorn_percentages("col") %>% 
  janitor::adorn_rounding(digits = 2) %>% 
    dplyr::mutate(across(-macrozona, ~ sprintf("%d (%.0f%%)", tab_clus_macrozona_pam_om4_q[[cur_column()]], . * 100))) |> 
  knitr::kable(caption="Porcentajes por columna, conglomerado vs. macrozona")
$chisq_statistic
[1] "125.88"

$chisq_df
df 
15 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.08"

$chisq_statistic
[1] "130.33"

$chisq_df
df 
15 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.09"
Porcentajes por columna, conglomerado vs. macrozona
macrozona 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
Macrozona Austral 162 (3%) 28 (4%) 11 (3%) 8 (4%)
Macrozona Centro 451 (9%) 91 (13%) 42 (12%) 12 (6%)
Macrozona Centro Sur 969 (20%) 115 (17%) 68 (19%) 34 (16%)
Macrozona Norte 399 (8%) 28 (4%) 28 (8%) 7 (3%)
Macrozona Sur 659 (14%) 180 (26%) 40 (11%) 32 (15%)
RM 2148 (45%) 242 (35%) 165 (47%) 119 (56%)

Tiempo que demora esta sección: 0 minutos

Hay una asociación significativa aunque débil entre macrozona y pertenencia a cluster.

Code
chisq.posthoc.test(tab_clus_macrozona_pam_om4_q[-1]) %>% 
  dplyr::mutate_at(3:ncol(.), ~round(as.numeric(gsub("\\*","",.)),3)) %>% 
  #knitr::kable("html", caption="Comparación post-hoc, conglomerado-región")%>%
  group_by(Dimension) %>%
  summarise(across(2:(ncol(.)-1),
                   ~ paste0(first(sprintf("%1.2f",.)), " (p=", last(sprintf("%1.3f",.)), ")"))) %>%
  dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=0.000)","p<0.001)",.)) %>% 
  #dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=1)","p=1.000)",.)) %>% 
  dplyr::mutate(Dimension= tab_clus_macrozona_pam_om4_q[1]) %>% 
  knitr::kable("markdown", caption="Comparación post-hoc, conglomerado-Macrozona")
Comparación post-hoc, conglomerado-Macrozona
Dimension 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
Macrozona Austral -0.65 (p=1.000) 0.96 (p=1.000) -0.38 (p=1.000) 0.25 (p=1.000)
Macrozona Centro -2.30 (p=0.512) 3.20 (p=0.033) 1.30 (p=1.000) -2.09 (p=0.874)
Macrozona Centro Sur 2.28 (p=0.541) -1.98 (p=1.000) -0.21 (p=1.000) -1.34 (p=1.000)
Macrozona Norte 3.90 (p=0.002) -3.72 (p=0.005) 0.19 (p=1.000) -2.42 (p=0.367)
Macrozona Sur -5.63 (p<0.001) 8.71 (p<0.001) -2.05 (p=0.963) 0.00 (p=1.000)
RM 1.76 (p=1.000) -4.98 (p<0.001) 0.91 (p=1.000) 3.54 (p=0.010)

Tiempo que demora esta sección: 0 minutos

Code
pairwise_chisq_gof_test(tab_clus_macrozona_pam_om4_q[-1], p.adjust.method="holm")|> 
  knitr::kable("markdown", caption="Dependencia categórica sol. 4 conglomerados, por pares de categorías en Macrozona (corrección Holm-Bonferroni)")

#Groups sharing a letter are not significantlt different (alpha = 0.05)
Dependencia categórica sol. 4 conglomerados, por pares de categorías en Macrozona (corrección Holm-Bonferroni)
n group1 group2 statistic p df p.adj p.adj.signif
5472 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 101.141312 0.00e+00 5 0.00e+00 ****
5142 6035, Un trimestre, TSM(4) 5939, Un semestre TSM(1) 4.070616 5.39e-01 5 5.39e-01 ns
5000 6035, Un trimestre, TSM(4) 5989, Comorbilidad un trimestre(2) 17.250511 4.05e-03 5 1.22e-02 *
1038 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 40.358215 1.00e-07 5 6.00e-07 ****
896 6025, Un trimestre, TUS(3) 5989, Comorbilidad un trimestre(2) 34.496188 1.90e-06 5 7.60e-06 ****
566 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2) 14.713969 1.17e-02 5 2.34e-02 *

Tiempo que demora esta sección: 0 minutos

Hay una asociación entre pacientes en 6025, Un trimestre, TUS(3) y el resto de conglomerados. Particularmente, pacientes de este conglomerado pertenecen en mayor proporción a la zona sur (La Araucanía, Los Ríos y Los Lagos) y centro (Región de Coquimbo y de Valparaíso), aunque menos a la macrozona norte (Arica y Parinacota, Tarapacá, Antofagasta y Atacama) y la RM. Hay una asociación entre Pacientes en 6035, Un trimestre, TSM(4), en que éstos parecen pertenecer en mayor proporción a la Macrozona Norte, a excepción de comparado con pacientes en 5939, Un semestre TSM(1). Por otra parte, pacientes en el conglomerado 5989, Comorbilidad un trimestre(2) se encuentran en mayor proporción en la región Metropolitana

1.1.3.f. Comparación covariables- Sexo
Code
tab_clus_sexo_pam_om4_q<-  
  ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
    janitor::tabyl(glosa_sexo, clus_pam_om4 )

chisq_cramerv(tab_clus_sexo_pam_om4_q[,-1])
# $chisq_statistic
# [1] "246.14"
# 
# $chisq_df
# df 
#  3 
# 
# $chisq_p_value
# [1] "<0.001"
# 
# $cramers_v
# [1] "0.20"

message("Descartando valores negativos en sil width")
chisq_cramerv(with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q), table(glosa_sexo, clus_pam_om4))
)

tab_clus_sexo_pam_om4_q%>% 
  janitor::adorn_percentages("col") %>% 
  janitor::adorn_rounding(digits = 2) %>% 
  dplyr::mutate(across(-glosa_sexo, ~sprintf("%d (%.0f%%)", tab_clus_sexo_pam_om4_q[[cur_column()]],.*100)))|>
  #dplyr::mutate_at(2:ncol(.),~scales::percent(.)) %>% 
  knitr::kable(caption="Porcentajes por columna, conglomerado vs. sexo")
$chisq_statistic
[1] "246.14"

$chisq_df
df 
 3 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.20"

$chisq_statistic
[1] "247.04"

$chisq_df
df 
 3 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.20"
Porcentajes por columna, conglomerado vs. sexo
glosa_sexo 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
HOMBRE 1993 (42%) 480 (70%) 145 (41%) 146 (69%)
MUJER 2795 (58%) 204 (30%) 209 (59%) 66 (31%)

Tiempo que demora esta sección: 0 minutos

Hay una asociación con una fuerza débil-moderada entre la pertenencia a un conglomerado y el sexo.

Code
chisq.posthoc.test(tab_clus_sexo_pam_om4_q[-1])%>% 
    dplyr::mutate(Dimension= rep(c("HOMBRE", "MUJER"), each=2)) %>% 
    dplyr::filter(Dimension=="MUJER") %>%
    dplyr::mutate(across(3:ncol(.), ~ dplyr::case_when(Value=="Residuals"~ sprintf("%1.2f", as.numeric(.)), Value=="p values"~ sprintf("%1.3f", as.numeric(gsub("\\*","",.)))))) %>% 
  dplyr::mutate(across(3:ncol(.), ~ dplyr::case_when(Value=="p values" & .=="0.000"~"<0.001",T~.))) %>% 
  knitr::kable("markdown", caption="Post-hoc, conglomerado vs. sexo")
Post-hoc, conglomerado vs. sexo
Dimension Value 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
MUJER Residuals 12.67 -13.60 1.87 -6.87
MUJER p values <0.001 <0.001 0.487 <0.001

Tiempo que demora esta sección: 0 minutos

Code
pairwise_chisq_gof_test(tab_clus_sexo_pam_om4_q[-1], p.adjust.method="holm")|> 
    dplyr::mutate(p.adj= dplyr::case_when(p.adj<0.001~ "<0.001",T~ sprintf("%1.3f",p.adj)))|> 
  knitr::kable("markdown", caption="Dependencia categórica sol. 4 conglomerados, por pares de categorías en Sexo (corrección Holm-Bonferroni)")
Dependencia categórica sol. 4 conglomerados, por pares de categorías en Sexo (corrección Holm-Bonferroni)
n group1 group2 statistic p df p.adj p.adj.signif
5472 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 195.8119436 0.000 1 <0.001 ****
5142 6035, Un trimestre, TSM(4) 5939, Un semestre TSM(1) 0.0356785 0.850 1 1.000 ns
5000 6035, Un trimestre, TSM(4) 5989, Comorbilidad un trimestre(2) 60.4441006 0.000 1 <0.001 ****
1038 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 81.8920873 0.000 1 <0.001 ****
896 6025, Un trimestre, TUS(3) 5989, Comorbilidad un trimestre(2) 0.0766505 0.782 1 1.000 ns
566 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2) 40.2303954 0.000 1 <0.001 ****

Tiempo que demora esta sección: 0 minutos

Pacientes en 6025, Un trimestre, TUS(3) y 5989, Comorbilidad un trimestre(2) están compuesto por menos mujeres que 6035, Un trimestre, TSM(4) y 5939, Un semestre TSM(1).

1.1.3.g. Comparación covariables- Edad
Code
dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
  dplyr::filter(quarter == 0) %>%
  dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_pam_om4")], by="run") %>%
  dplyr::group_by(clus_pam_om4) %>%
  dplyr::summarise(mean_edad = mean(min_edad_anos),
                   sd= sd(min_edad_anos),
                   ci_lower = mean(min_edad_anos) - qt(0.975, n()-1) * sd(min_edad_anos)/sqrt(n()),
                   ci_upper = mean(min_edad_anos) + qt(0.975, n()-1) * sd(min_edad_anos)/sqrt(n())) %>% # Plot con ggplot2
ggplot(aes(x = clus_pam_om4, y = mean_edad)) +
  geom_point() +
  geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper), width = 0.2) +
  labs(title = NULL,
       x = "Conglomerado",
       y = "Edad promedio") +
  theme_minimal()+
  coord_flip()

ggsave("_figs/edad_minima_por_cluster_pam_om4_q.png", dpi=600)
Edad promedio primer ingreso con intervalo de confianza por conglomerado

Edad promedio primer ingreso con intervalo de confianza por conglomerado

Tiempo que demora esta sección: 0.1 minutos

Code
invisible("Prueba de Levene par igualdad de varianzas")
with(dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
               dplyr::filter(quarter == 0) %>%
               dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_pam_om4")], by="run"), car::leveneTest(min_edad_anos, clus_pam_om4))
#NS
anova_clus_pam_om4_q <- oneway.test(min_edad_anos ~ clus_pam_om4, 
             data = dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
               dplyr::filter(quarter == 0) %>%
               dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_pam_om4")], by="run"),var.equal = T)

with(dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
               dplyr::filter(quarter == 0) %>%
               dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_pam_om4")], by="run"), oneway_anova_effect_size (min_edad_anos, clus_pam_om4))

# Ver los resultados del ANOVA
print(anova_clus_pam_om4_q)
#F = 51.5, num df = 3, denom df = 6034, p-value < 2.2e-16
#$eta_squared
#[1] 0.0249659


message("Descartando valores negativos en sil width")
with(dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
    dplyr::filter(quarter == 0) %>%
    dplyr::inner_join(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q)[,c("run","clus_pam_om4")], by="run"), 
     oneway.test(min_edad_anos ~ clus_pam_om4,var.equal = T)
     )
Levene's Test for Homogeneity of Variance (center = median)
        Df F value Pr(>F)
group    3  1.2631 0.2852
      6034               
$anova_summary
              Df Sum Sq Mean Sq F value Pr(>F)    
group          3   2853   951.1    51.5 <2e-16 ***
Residuals   6034 111440    18.5                   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

$eta_squared
[1] 0.0249659


    One-way analysis of means

data:  min_edad_anos and clus_pam_om4
F = 51.5, num df = 3, denom df = 6034, p-value < 2.2e-16


    One-way analysis of means

data:  min_edad_anos and clus_pam_om4
F = 49.735, num df = 3, denom df = 5899, p-value < 2.2e-16

Tiempo que demora esta sección: 0 minutos

Code
rstatix::games_howell_test(min_edad_anos ~ clus_pam_om4, 
  data =dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
               dplyr::filter(quarter == 0) %>%
               dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run","clus_pam_om4")], by="run")) %>% 
    dplyr::select(-1) %>% 
    dplyr::mutate(
    summary = sprintf(
      "%.2f [%.2f, %.2f], p= %s",
      as.numeric(estimate), 
      as.numeric(conf.low), 
      as.numeric(conf.high), 
      ifelse(p.adj < 0.001, "<0.001", sprintf("%.3f", p.adj)))) %>% 
  dplyr::select(!any_of(c("estimate","conf.low", "conf.high", "p.adj", "p.adj.signif"))) %>% 
  knitr::kable("markdown", col.names=c("Conglomerado1","Conglomerado2", "Estimación"), caption="Post-hoc, conglomerado vs. Promedio días de tratamiento")


message("Descartando valores negativos en sil width")
sens_min_anios_clus_pam_om4_q<-
rstatix::games_howell_test(min_edad_anos ~ clus_pam_om4,data = dt_ing_calendar_quarter_t_desde_primera_adm_dedup %>%
    dplyr::filter(quarter == 0) %>%
    dplyr::inner_join(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q)[,c("run","clus_pam_om4")], by="run")
     )
Post-hoc, conglomerado vs. Promedio días de tratamiento
Conglomerado1 Conglomerado2 Estimación
6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 1.96 [1.50, 2.41], p= <0.001
6035, Un trimestre, TSM(4) 5939, Un semestre TSM(1) -0.82 [-1.41, -0.22], p= 0.002
6035, Un trimestre, TSM(4) 5989, Comorbilidad un trimestre(2) 1.14 [0.37, 1.90], p= <0.001
6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) -2.77 [-3.48, -2.06], p= <0.001
6025, Un trimestre, TUS(3) 5989, Comorbilidad un trimestre(2) -0.82 [-1.68, 0.04], p= 0.066
5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2) 1.95 [1.02, 2.89], p= <0.001

Tiempo que demora esta sección: 0 minutos

Si bien la asociación entre edad mínima de ingreso es signifciatva, tiene un tamaño del efecto débil. Particularmente, pacientes clasificados como 6025, Un trimestre, TUS(3) y 5989, Comorbilidad un trimestre(2) ingresan de manera más tardía a tratamiento, a diferencia de pacientes clasificados en 5939, Un semestre TSM(1), quienes son los que ingresan más temprano, seguidos por una leve aunque significativa diferencia con 6035, Un trimestre, TSM(4).

1.1.3.h. Comparación covariables- Previsión
Code
tab_clus_prev_pam_om4_q<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>%
    janitor::tabyl(prev_benef_rec_post, clus_pam_om4)

tab_clus_prev_pam_om4_q%>% 
  {
     print(janitor::chisq.test(.))
     print(janitor::fisher.test(., simulate.p.value = T, B = 1e5))
  }
#X-squared = 25.206, df = 12, p-value = 0.01388
#p-value = 0.00299 Fisher

tab_clus_prev_pam_om4_q%>% 
  janitor::adorn_percentages("col") %>% 
  janitor::adorn_rounding(digits = 3) %>% 
  dplyr::mutate(across(-prev_benef_rec_post, ~sprintf("%d (%.0f%%)", tab_clus_prev_pam_om4_q[[cur_column()]],.*100))) |> 
  #dplyr::mutate_at(2:ncol(.),~scales::percent(.)) %>% 
  knitr::kable(caption="Porcentajes por columna, conglomerado vs. Previsión")

    Pearson's Chi-squared test

data:  .
X-squared = 25.206, df = 12, p-value = 0.01388


    Fisher's Exact Test for Count Data with simulated p-value (based on 1e+05 replicates)

data:  .
p-value = 0.01054
alternative hypothesis: two.sided
Porcentajes por columna, conglomerado vs. Previsión
prev_benef_rec_post 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
FFAA 202 (4%) 13 (2%) 12 (3%) 3 (1%)
FONASA A 1261 (26%) 192 (28%) 109 (31%) 58 (27%)
FONASA BC 1549 (32%) 220 (32%) 113 (32%) 81 (38%)
FONASA D 557 (12%) 99 (14%) 38 (11%) 27 (13%)
ISAPRE 1219 (26%) 160 (23%) 82 (23%) 43 (20%)

Tiempo que demora esta sección: 0 minutos

Code
chisq_cramerv(tab_clus_prev_pam_om4_q[,-1])
# $chisq_statistic
# [1] "25.21"
# 
# $chisq_df
# df 
# 12 
# 
# $chisq_p_value
# [1] "0.0139"
# 
# $cramers_v
# [1] "0.04"

message("Descartando valores negativos en sil width")
chisq_cramerv(with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q), table(prev_benef_rec_post, clus_pam_om4)))

chisq.posthoc.test(tab_clus_prev_pam_om4_q[,-1]) %>% 
    dplyr::mutate_at(3:ncol(.), ~round(as.numeric(gsub("\\*","",.)),3)) %>% 
    #knitr::kable("html", caption="Comparación post-hoc, conglomerado-región")%>%
    group_by(Dimension) %>%
    summarise(across(2:(ncol(.)-1),
                     ~ paste0(first(sprintf("%1.2f",.)), " (p=", last(sprintf("%1.3f",.)), ")"))) %>%
    dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=0.000)","p<0.001)",.)) %>% 
    #dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=1)","p=1.000)",.)) %>% 
    dplyr::mutate(Dimension= dplyr::pull(tab_clus_prev_pam_om4_q[1])) %>% 
    knitr::kable("markdown", caption="Comparación post-hoc, conglomerado-previsión")

pairwise_chisq_gof_test(tab_clus_prev_pam_om4_q[-1], p.adjust.method="holm")|> 
    knitr::kable("markdown", caption="Dependencia categórica sol. 4 conglomerados, por pares de categorías en Previsión (corrección Holm-Bonferroni)")
$chisq_statistic
[1] "25.21"

$chisq_df
df 
12 

$chisq_p_value
[1] "0.0139"

$cramers_v
[1] "0.04"

$chisq_statistic
[1] "25.18"

$chisq_df
df 
12 

$chisq_p_value
[1] "0.0140"

$cramers_v
[1] "0.04"
Comparación post-hoc, conglomerado-previsión
Dimension 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
FFAA 3.25 (p=0.023) -2.77 (p=0.112) -0.42 (p=1.000) -1.85 (p=1.000)
FONASA A -1.69 (p=1.000) 0.78 (p=1.000) 1.73 (p=1.000) 0.18 (p=1.000)
FONASA BC -0.52 (p=1.000) -0.21 (p=1.000) -0.24 (p=1.000) 1.80 (p=1.000)
FONASA D -1.44 (p=1.000) 2.17 (p=0.601) -0.72 (p=1.000) 0.36 (p=1.000)
ISAPRE 1.94 (p=1.000) -0.97 (p=1.000) -0.78 (p=1.000) -1.58 (p=1.000)
Dependencia categórica sol. 4 conglomerados, por pares de categorías en Previsión (corrección Holm-Bonferroni)
n group1 group2 statistic p df p.adj p.adj.signif
5472 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 13.913777 0.00758 4 0.0455 *
5142 6035, Un trimestre, TSM(4) 5939, Un semestre TSM(1) 3.934674 0.41500 4 1.0000 ns
5000 6035, Un trimestre, TSM(4) 5989, Comorbilidad un trimestre(2) 8.474783 0.07570 4 0.3780 ns
1038 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5.224236 0.26500 4 1.0000 ns
896 6025, Un trimestre, TUS(3) 5989, Comorbilidad un trimestre(2) 3.040659 0.55100 4 1.0000 ns
566 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2) 4.970130 0.29000 4 1.0000 ns

Tiempo que demora esta sección: 0 minutos

Los pacientes en el conglomerado 6035, Un trimestre, TSM(4) muestra un porcentaje mayor de personas con previsión de las FFAA, particularmente, a diferencia de pacientes en el conglomerado 6025, Un trimestre, TUS(3).

1.1.3.i. Comparación covariables- Niv. Complejidad
Code
tab_clus_compl_pam_om4_q<-
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens %>% 
  dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], 
                    by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first") %>% 
  janitor::tabyl(nivel_de_complejidad, clus_pam_om4) 

tab_clus_compl_pam_om4_q%>% 
  janitor::adorn_percentages("col") %>% 
  janitor::adorn_rounding(digits = 2) %>% 
   dplyr::mutate_at(2:ncol(.), ~scales::percent(as.numeric(.), accuracy=.1)) %>% 
  knitr::kable(caption="Tabla de contingencia, Niv. de complejidad (proporción por columna)")
Tabla de contingencia, Niv. de complejidad (proporción por columna)
nivel_de_complejidad 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
Alta Complejidad 61.0% 68.0% 51.0% 75.0%
Baja Complejidad 16.0% 19.0% 17.0% 9.0%
Mediana Complejidad 19.0% 12.0% 27.0% 16.0%
Pendiente 2.0% 1.0% 5.0% 1.0%
Sin dato 1.0% 1.0% 1.0% 0.0%

Tiempo que demora esta sección: 0 minutos

Code
tab_clus_compl_pam_om4_q %>% 
  janitor::fisher.test(simulate.p.value=T, B=1e5)
#p-value = 1e-05


chisq_cramerv(tab_clus_compl_pam_om4_q[,-1])
# $chisq_statistic
# [1] "79.79"
# 
# $chisq_df
# df 
# 12 
# 
# $chisq_p_value
# [1] "<0.001"
# 
# $cramers_v
# [1] "0.07"

message("Descartando valores negativos en sil width")
chisq_cramerv(with(subset(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens, !rn %in% sil_neg_pam_om_clus4_q) %>% 
  dplyr::inner_join(data_long_establecimiento_2024_std[,c("ESTAB_HOMO", "codigo_region", "nivel_de_atencion", "nivel_de_complejidad")], 
  by = c("estab_homo_base" = "ESTAB_HOMO"), multiple = "first"), table(nivel_de_complejidad, clus_pam_om4)))

chisq.posthoc.test(tab_clus_compl_pam_om4_q[-1]) %>% 
    dplyr::mutate_at(3:ncol(.), ~round(as.numeric(gsub("\\*","",.)),3)) %>% 
    #knitr::kable("html", caption="Comparación post-hoc, conglomerado-región")%>%
    group_by(Dimension) %>%
    summarise(across(2:(ncol(.)-1),
                     ~ paste0(first(sprintf("%1.2f",.)), " (p=", last(sprintf("%1.3f",.)), ")"))) %>%
    dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=0.000)","p<0.001)",.)) %>% 
    #dplyr::mutate_at(2:length(names(.)), ~gsub("p\\=1)","p=1.000)",.)) %>% 
    dplyr::mutate(Dimension= dplyr::pull(tab_clus_compl_pam_om4_q[1])) %>% 
    knitr::kable("markdown", caption="Comparación post-hoc, conglomerado-Niv. complejidad")

pairwise_chisq_gof_test(tab_clus_compl_pam_om4_q[-1], p.adjust.method="holm")|> 
    knitr::kable("markdown", caption="Dependencia categórica sol. 4 conglomerados, por pares de categorías en Niv. Complejidad (corrección Holm-Bonferroni)")

    Fisher's Exact Test for Count Data with simulated p-value (based on 1e+05 replicates)

data:  .
p-value = 1e-05
alternative hypothesis: two.sided

$chisq_statistic
[1] "79.79"

$chisq_df
df 
12 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.07"

$chisq_statistic
[1] "61.75"

$chisq_df
df 
12 

$chisq_p_value
[1] "<0.001"

$cramers_v
[1] "0.06"
Comparación post-hoc, conglomerado-Niv. complejidad
Dimension 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2)
Alta Complejidad -1.80 (p=1.000) 3.45 (p=0.011) -4.55 (p<0.001) 3.84 (p=0.002)
Baja Complejidad -0.46 (p=1.000) 1.88 (p=1.000) 0.54 (p=1.000) -2.92 (p=0.071)
Mediana Complejidad 2.37 (p=0.355) -5.16 (p<0.001) 3.84 (p=0.002) -1.23 (p=1.000)
Pendiente 1.22 (p=1.000) -2.91 (p=0.072) 2.87 (p=0.083) -1.34 (p=1.000)
Sin dato -0.79 (p=1.000) 1.03 (p=1.000) 0.96 (p=1.000) -1.25 (p=1.000)
Dependencia categórica sol. 4 conglomerados, por pares de categorías en Niv. Complejidad (corrección Holm-Bonferroni)
n group1 group2 statistic p df p.adj p.adj.signif
5472 6035, Un trimestre, TSM(4) 6025, Un trimestre, TUS(3) 35.60142 3.00e-07 4 1.70e-06 ****
5142 6035, Un trimestre, TSM(4) 5939, Un semestre TSM(1) 21.68587 2.31e-04 4 6.93e-04 ***
5000 6035, Un trimestre, TSM(4) 5989, Comorbilidad un trimestre(2) 17.08293 1.86e-03 4 3.72e-03 **
1038 6025, Un trimestre, TUS(3) 5939, Un semestre TSM(1) 59.77247 0.00e+00 4 0.00e+00 ****
896 6025, Un trimestre, TUS(3) 5989, Comorbilidad un trimestre(2) 14.72857 5.30e-03 4 5.30e-03 **
566 5939, Un semestre TSM(1) 5989, Comorbilidad un trimestre(2) 34.06543 7.00e-07 4 2.90e-06 ****

Tiempo que demora esta sección: 0 minutos

Se constata una asociación significativa aunque débil entre nivel de complejidad de los establecimientos y el conglomerado en los que son clasificados los pacientes. Particularmente, quienes son clasificados en 5939, Un semestre TSM(1) se encuentran en menor proporción en centros de alta complejidad, mientras que pacientes en 5989, Comorbilidad un trimestre(2) se encuentran en mayor proporción en centros de alta complejidad. Por otra parte, pacientes clasificados en 6025, Un trimestre, TUS(3) se encuentran en menor proporción en centros de Mediana complejidad y en mayor proporción en centros de alta complejidad.

1.1.4. Compilación comparación covariables

Code
# Definir los datos correctamente
data_pam_om4_q <-cbind.data.frame(
  Grupo= c("6035,\nUn trimestre,\nTSM(4)", 
             "6025,\nUn trimestre,\nTUS(3)", 
             "5939,\nUn semestre\nTSM(1)", 
             "5989,\nComorbilidad un\ntrimestre(2)"), 
      PPOO_bin            = c(NA, NA, NA, NA), 
      PPOO_sinautoid          = c(NA, NA, NA, NA), 
      PPOO_conautoid          = c(NA, NA, NA, NA), 
      Mortalidad              = c(NA, NA, NA, NA), 
      RM                      = c(NA, "-", NA, "+"), 
      `Macrozona-Austral`       = c(NA, NA, NA, NA), 
      `Macrozona-Centro`        = c(NA, NA, NA, NA), 
      `Macrozona-Centro Sur`    = c(NA, NA, NA, NA), 
      `Macrozona-Norte`        = c("+","-", NA, NA), 
      `Macrozona-Sur`         = c(NA, "+", NA, NA), 
      Sexo_mujeres             = c(NA, "-", NA, "-"), 
      `Edad ingreso`         = c("-", "+", "-", "+"), 
      `Previsión-FFAA`         = c("+", "-", NA, NA), 
      `Previsión-FONASA A`     = c(NA, NA, NA, NA), 
      `Previsión-FONASA BC`     = c(NA, NA, NA, NA), 
      `Previsión-FONASA D`     = c(NA, NA, NA, NA), 
      `Previsión-ISAPRE`     = c(NA, NA, NA, NA), 
      `NivComp-Baja`     = c(NA, NA, NA, NA), 
      `NivComp-Media`     = c(NA, "-", NA, NA), 
      `NivComp-Alta`     = c(NA, "+", "-", "+"))
#
# Asegurar que los nombres de las columnas sean válidos y no haya espacios en blanco
# Derretir el dataframe para que sea adecuado para ggplot2
data_melt_pam_om4_q <- reshape2::melt(data_pam_om4_q, id.vars = 'Grupo', variable.name = 'Variable', value.name = 'Asociación')

# Reemplazar los NA por un valor vacío
data_melt_pam_om4_q$Asociación[is.na(data_melt_pam_om4_q$Asociación)] <- "\n"

# Crear el gráfico con ggplot
data_melt_pam_om4_q %>% 
  dplyr::mutate(Variable = gsub("_", " ", Variable)) %>% 
ggplot(aes(x = Variable, y = Grupo, fill = Asociación)) +
  geom_tile(color = "white", size = 0.8) +
  scale_fill_manual(values = c("+" = "#556B2F", "-" = "#E2725B", "\n" = "white")) +
  labs(title =NULL, x = "Variables", y = "Conglomerado") +
  theme_minimal() +
  theme(#axis.text.x = element_text(angle = 45, hjust = 1),
        panel.grid = element_blank())+
  theme(
    axis.text.y = element_text(size = 17, face = "bold"),#,margin = margin(l = 7)),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 17, face = "bold"),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 16, face = "bold"),#,margin = margin(t = -15)),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 16, face = "bold"),          # Tamaño del título del eje Y
    plot.title = NULL,  # Tamaño y estilo del título del gráfico
    legend.title = element_text(size = 17, face = "bold"),          # Tamaño del título de la leyenda
    legend.spacing.y = unit(1.5, "lines"),
    legend.box.spacing = unit(0.5, "lines"),      # Controla el espacio entre la leyenda y el gráfico
    legend.margin = margin(5, 5, 5, 5),  
    legend.key.height = unit(1, "cm"),  
    legend.text = element_text(size = 15, face = "bold")            # Tamaño del texto de la leyenda
  ) +
  coord_flip()
ggsave("_figs/asociaciones_pam_om4_q.png", width=8.8*.8, height=5*.8, dpi=1000)
Comparación covariables con agrupamiento

Comparación covariables con agrupamiento

Tiempo que demora esta sección: 0.1 minutos


Información de la sesión

Code
message(paste0("R library: ", Sys.getenv("R_LIBS_USER")))

R library: C:/R/win-library/4.4

Code
message(paste0("Date: ",withr::with_locale(new = c('LC_TIME' = 'C'), code =Sys.time())))

Date: 2025-01-21 16:58:59.832898

Code
message(paste0("Editor context: ", getwd()))

Editor context: H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II

Code
save.image("avance250117.RData")

Tiempo que demora esta sección: 0.2 minutos

Code
sesion_info <- devtools::session_info()
dplyr::select(
  tibble::as_tibble(sesion_info$packages),
  c(package, loadedversion, source)
) %>% 
 knitr::kable(caption = "R packages", format = "html",
      col.names = c("Row number", "Package", "Version"),
    row.names = FALSE,
      align = c("c", "l", "r")) %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")  
R packages
Row number Package Version
abind 1.4-5 CRAN (R 4.4.0)
backports 1.5.0 CRAN (R 4.4.0)
boot 1.3-30 CRAN (R 4.4.0)
broom 1.0.6 CRAN (R 4.4.0)
cachem 1.1.0 CRAN (R 4.4.0)
car 3.1-2 CRAN (R 4.4.1)
carData 3.0-5 CRAN (R 4.4.1)
chisq.posthoc.test 0.1.3 Github (ebbertd/chisq.posthoc.test@186d2ca6bbdba9fc19601aff4696ae1b85e7e0b0)
cli 3.6.3 CRAN (R 4.4.1)
cluster 2.1.6 CRAN (R 4.4.0)
coda 0.19-4.1 CRAN (R 4.4.1)
codetools 0.2-20 CRAN (R 4.4.0)
colorspace 2.1-0 CRAN (R 4.4.0)
cowplot 1.1.3 CRAN (R 4.4.1)
crayon 1.5.3 CRAN (R 4.4.2)
curl 6.0.1 CRAN (R 4.4.2)
data.table 1.15.4 CRAN (R 4.4.0)
devtools 2.4.5 CRAN (R 4.4.1)
DiagrammeR 1.0.11 CRAN (R 4.4.0)
DiagrammeRsvg 0.1 CRAN (R 4.4.1)
digest 0.6.37 CRAN (R 4.4.0)
doFuture 1.0.1 CRAN (R 4.4.0)
doParallel 1.0.17 CRAN (R 4.4.0)
dplyr 1.1.4 CRAN (R 4.4.0)
ellipsis 0.3.2 CRAN (R 4.4.0)
emmeans 1.10.3 CRAN (R 4.4.1)
estimability 1.5.1 CRAN (R 4.4.1)
evaluate 1.0.1 CRAN (R 4.4.2)
expsmooth 2.3 CRAN (R 4.4.1)
factoextra 1.0.7 CRAN (R 4.4.1)
fansi 1.0.6 CRAN (R 4.4.0)
farver 2.1.2 CRAN (R 4.4.0)
fastmap 1.2.0 CRAN (R 4.4.0)
fma 2.5 CRAN (R 4.4.1)
forcats 1.0.0 CRAN (R 4.4.0)
foreach 1.5.2 CRAN (R 4.4.0)
forecast 8.23.0 CRAN (R 4.4.1)
fpp2 2.5 CRAN (R 4.4.1)
fracdiff 1.5-3 CRAN (R 4.4.1)
fs 1.6.5 CRAN (R 4.4.2)
future 1.33.2 CRAN (R 4.4.0)
future.apply 1.11.2 CRAN (R 4.4.0)
generics 0.1.3 CRAN (R 4.4.0)
ggh4x 0.2.8 CRAN (R 4.4.1)
ggplot2 3.5.1 CRAN (R 4.4.0)
ggpubr 0.6.0 CRAN (R 4.4.1)
ggrepel 0.9.5 CRAN (R 4.4.1)
ggseqplot 0.8.4 CRAN (R 4.4.1)
ggsignif 0.6.4 CRAN (R 4.4.1)
globals 0.16.3 CRAN (R 4.4.0)
glue 1.8.0 CRAN (R 4.4.2)
gridExtra 2.3 CRAN (R 4.4.0)
gtable 0.3.5 CRAN (R 4.4.0)
gtsummary 2.0.2 CRAN (R 4.4.1)
haven 2.5.4 CRAN (R 4.4.0)
here 1.0.1 CRAN (R 4.4.1)
hms 1.1.3 CRAN (R 4.4.0)
htmltools 0.5.8 CRAN (R 4.4.0)
htmlwidgets 1.6.4 CRAN (R 4.4.0)
httpuv 1.6.15 CRAN (R 4.4.0)
iterators 1.0.14 CRAN (R 4.4.0)
janitor 2.2.0 CRAN (R 4.4.0)
job 0.3.1 CRAN (R 4.4.1)
jsonlite 1.8.9 CRAN (R 4.4.2)
kableExtra 1.4.0 CRAN (R 4.4.1)
knitr 1.49 CRAN (R 4.4.2)
labeling 0.4.3 CRAN (R 4.4.0)
later 1.4.1 CRAN (R 4.4.2)
lattice 0.22-6 CRAN (R 4.4.0)
lifecycle 1.0.4 CRAN (R 4.4.0)
listenv 0.9.1 CRAN (R 4.4.0)
lmtest 0.9-40 CRAN (R 4.4.1)
lubridate 1.9.3 CRAN (R 4.4.0)
magrittr 2.0.3 CRAN (R 4.4.0)
MASS 7.3-60.2 local
Matrix 1.7-0 CRAN (R 4.4.0)
memoise 2.0.1 CRAN (R 4.4.0)
mgcv 1.9-1 CRAN (R 4.4.0)
mime 0.12 CRAN (R 4.4.0)
miniUI 0.1.1.1 CRAN (R 4.4.0)
mnormt 2.1.1 CRAN (R 4.4.0)
multcomp 1.4-26 CRAN (R 4.4.0)
munsell 0.5.1 CRAN (R 4.4.0)
mvtnorm 1.2-5 CRAN (R 4.4.0)
NbClust 3.0.1 CRAN (R 4.4.0)
nlme 3.1-164 CRAN (R 4.4.0)
nnet 7.3-19 CRAN (R 4.4.0)
pacman 0.5.1 CRAN (R 4.4.1)
parallelly 1.37.1 CRAN (R 4.4.0)
patchwork 1.2.0 CRAN (R 4.4.1)
permute 0.9-7 CRAN (R 4.4.0)
pillar 1.9.0 CRAN (R 4.4.0)
pkgbuild 1.4.5 CRAN (R 4.4.2)
pkgconfig 2.0.3 CRAN (R 4.4.0)
pkgload 1.4.0 CRAN (R 4.4.2)
plyr 1.8.9 CRAN (R 4.4.0)
png 0.1-8 CRAN (R 4.4.0)
profvis 0.4.0 CRAN (R 4.4.2)
progressr 0.14.0 CRAN (R 4.4.0)
promises 1.3.2 CRAN (R 4.4.2)
psych 2.4.3 CRAN (R 4.4.0)
purrr 1.0.2 CRAN (R 4.4.0)
quadprog 1.5-8 CRAN (R 4.4.0)
quantmod 0.4.26 CRAN (R 4.4.1)
R.methodsS3 1.8.2 CRAN (R 4.4.0)
R.oo 1.26.0 CRAN (R 4.4.0)
R.utils 2.12.3 CRAN (R 4.4.0)
R6 2.5.1 CRAN (R 4.4.0)
ragg 1.3.3 CRAN (R 4.4.2)
rbibutils 2.2.16 CRAN (R 4.4.1)
RColorBrewer 1.1-3 CRAN (R 4.4.0)
Rcpp 1.0.13 CRAN (R 4.4.1)
Rdpack 2.6 CRAN (R 4.4.1)
readr 2.1.5 CRAN (R 4.4.0)
remotes 2.5.0 CRAN (R 4.4.0)
reshape2 1.4.4 CRAN (R 4.4.0)
reticulate 1.38.0 CRAN (R 4.4.1)
rio 1.1.1 CRAN (R 4.4.0)
rlang 1.1.4 CRAN (R 4.4.0)
rmarkdown 2.29 CRAN (R 4.4.2)
rprojroot 2.0.4 CRAN (R 4.4.0)
rstatix 0.7.2 CRAN (R 4.4.1)
rstudioapi 0.17.1 CRAN (R 4.4.2)
rsvg 2.6.0 CRAN (R 4.4.0)
sandwich 3.1-0 CRAN (R 4.4.1)
scales 1.3.0 CRAN (R 4.4.0)
sessioninfo 1.2.2 CRAN (R 4.4.0)
shiny 1.9.1 CRAN (R 4.4.2)
snakecase 0.11.1 CRAN (R 4.4.0)
stargazer 5.2.3 CRAN (R 4.4.0)
stringi 1.8.4 CRAN (R 4.4.0)
stringr 1.5.1 CRAN (R 4.4.0)
survival 3.5-8 CRAN (R 4.4.0)
svglite 2.1.3 CRAN (R 4.4.1)
systemfonts 1.1.0 CRAN (R 4.4.0)
textshaping 0.4.0 CRAN (R 4.4.0)
TH.data 1.1-2 CRAN (R 4.4.1)
tibble 3.2.1 CRAN (R 4.4.0)
tidyr 1.3.1 CRAN (R 4.4.0)
tidyselect 1.2.1 CRAN (R 4.4.0)
tidyverse 2.0.0 CRAN (R 4.4.0)
timechange 0.3.0 CRAN (R 4.4.0)
timeDate 4032.109 CRAN (R 4.4.0)
Tmisc 1.0.1 CRAN (R 4.4.1)
TraMineR 2.2-10 CRAN (R 4.4.0)
TraMineRextras 0.6.7 CRAN (R 4.4.0)
tseries 0.10-58 CRAN (R 4.4.1)
TTR 0.24.4 CRAN (R 4.4.1)
tzdb 0.4.0 CRAN (R 4.4.0)
urca 1.3-4 CRAN (R 4.4.1)
urlchecker 1.0.1 CRAN (R 4.4.0)
usethis 3.1.0 CRAN (R 4.4.2)
utf8 1.2.4 CRAN (R 4.4.0)
V8 4.4.2 CRAN (R 4.4.0)
vctrs 0.6.5 CRAN (R 4.4.0)
vegan 2.6-6.1 CRAN (R 4.4.0)
viridisLite 0.4.2 CRAN (R 4.4.0)
visNetwork 2.1.2 CRAN (R 4.4.0)
WeightedCluster 1.6-4 CRAN (R 4.4.0)
withr 3.0.2 CRAN (R 4.4.2)
writexl 1.5.0 CRAN (R 4.4.0)
xfun 0.49 CRAN (R 4.4.2)
xml2 1.3.6 CRAN (R 4.4.0)
xtable 1.8-4 CRAN (R 4.4.0)
xts 0.14.0 CRAN (R 4.4.1)
yaml 2.3.10 CRAN (R 4.4.1)
zoo 1.8-12 CRAN (R 4.4.0)

Tiempo que demora esta sección: 0 minutos

Code
reticulate::py_list_packages()%>% 
 knitr::kable(caption = "Python packages", format = "html",
      col.names = c("Package", "Version", "Requirement"),
    row.names = FALSE,
      align = c("c", "l", "r", "r"))%>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) %>% 
  kableExtra::scroll_box(width = "100%", height = "375px")  
Python packages
Package Version Requirement
absl-py 2.1.0 absl-py==2.1.0
asttokens 2.4.1 asttokens==2.4.1
astunparse 1.6.3 astunparse==1.6.3
audioconverter 2.0.3 audioconverter==2.0.3
autograd 1.6.2 autograd==1.6.2
autograd-gamma 0.5.0 autograd-gamma==0.5.0
beautifulsoup4 4.12.3 beautifulsoup4==4.12.3
Brotli 1.1.0 Brotli==1.1.0
certifi 2023.11.17 certifi==2023.11.17
cffi 1.16.0 cffi==1.16.0
charset-normalizer 3.3.2 charset-normalizer==3.3.2
clarabel 0.9.0 clarabel==0.9.0
click 8.1.7 click==8.1.7
cloudpickle 3.0.0 cloudpickle==3.0.0
colorama 0.4.6 colorama==0.4.6
comm 0.2.1 comm==0.2.1
contourpy 1.2.0 contourpy==1.2.0
cvxopt 1.3.2 cvxopt==1.3.2
cvxpy 1.5.2 cvxpy==1.5.2
cycler 0.12.1 cycler==0.12.1
debugpy 1.8.0 debugpy==1.8.0
decorator 4.4.2 decorator==4.4.2
delete-chrome-history-py 0.1.8 delete-chrome-history-py==0.1.8
easyocr 1.7.1 easyocr==1.7.1
ecos 2.0.13 ecos==2.0.13
editdistance 0.8.1 editdistance==0.8.1
efficientnet 1.0.0 efficientnet==1.0.0
essential-generators 1.0 essential-generators==1.0
et-xmlfile 1.1.0 et-xmlfile==1.1.0
executing 2.0.1 executing==2.0.1
fancyimpute 0.7.0 fancyimpute==0.7.0
ffmpeg 1.4 ffmpeg==1.4
ffmpeg-python 0.2.0 ffmpeg-python==0.2.0
filedir 0.0.3 filedir==0.0.3
filelock 3.13.1 filelock==3.13.1
flatbuffers 24.3.25 flatbuffers==24.3.25
fonttools 4.47.2 fonttools==4.47.2
formulaic 1.0.1 formulaic==1.0.1
fsspec 2023.12.2 fsspec==2023.12.2
future 0.18.3 future==0.18.3
gast 0.6.0 gast==0.6.0
git-filter-repo 2.45.0 git-filter-repo==2.45.0
google-pasta 0.2.0 google-pasta==0.2.0
graphviz 0.20.3 graphviz==0.20.3
grpcio 1.65.4 grpcio==1.65.4
gTTS 2.5.1 gTTS==2.5.1
h5py 3.11.0 h5py==3.11.0
idna 3.6 idna==3.6
imageio 2.34.2 imageio==2.34.2
imageio-ffmpeg 0.5.1 imageio-ffmpeg==0.5.1
imgaug 0.4.0 imgaug==0.4.0
iniconfig 2.0.0 iniconfig==2.0.0
interface-meta 1.3.0 interface-meta==1.3.0
ipykernel 6.29.5 ipykernel==6.29.5
ipython 8.20.0 ipython==8.20.0
jedi 0.19.1 jedi==0.19.1
Jinja2 3.1.3 Jinja2==3.1.3
joblib 1.4.0 joblib==1.4.0
jupyter_client 8.6.0 jupyter_client==8.6.0
jupyter_core 5.7.1 jupyter_core==5.7.1
keras 3.4.1 keras==3.4.1
Keras-Applications 1.0.8 Keras-Applications==1.0.8
keras-ocr 0.9.3 keras-ocr==0.9.3
kiwisolver 1.4.5 kiwisolver==1.4.5
knnimpute 0.1.0 knnimpute==0.1.0
lazy_loader 0.4 lazy_loader==0.4
libclang 18.1.1 libclang==18.1.1
lifelines 0.28.0 lifelines==0.28.0
llvmlite 0.41.1 llvmlite==0.41.1
Markdown 3.6 Markdown==3.6
markdown-it-py 3.0.0 markdown-it-py==3.0.0
MarkupSafe 2.1.4 MarkupSafe==2.1.4
matplotlib 3.8.2 matplotlib==3.8.2
matplotlib-inline 0.1.6 matplotlib-inline==0.1.6
mdurl 0.1.2 mdurl==0.1.2
mido 1.3.3 mido==1.3.3
ml-dtypes 0.4.0 ml-dtypes==0.4.0
more-itertools 10.2.0 more-itertools==10.2.0
moviepy 1.0.3 moviepy==1.0.3
mpmath 1.3.0 mpmath==1.3.0
multipledispatch 1.0.0 multipledispatch==1.0.0
mutagen 1.47.0 mutagen==1.47.0
namex 0.0.8 namex==0.0.8
natsort 8.4.0 natsort==8.4.0
nest-asyncio 1.5.9 nest-asyncio==1.5.9
networkx 3.2.1 networkx==3.2.1
ninja 1.11.1.1 ninja==1.11.1.1
nose 1.3.7 nose==1.3.7
numba 0.58.1 numba==0.58.1
numexpr 2.10.0 numexpr==2.10.0
numpy 1.26.3 numpy==1.26.3
openai-whisper 20231117 openai-whisper==20231117
opencv-python 4.10.0.84 opencv-python==4.10.0.84
opencv-python-headless 4.10.0.84 opencv-python-headless==4.10.0.84
openpyxl 3.1.4 openpyxl==3.1.4
opt-einsum 3.3.0 opt-einsum==3.3.0
optree 0.12.1 optree==0.12.1
osqp 0.6.5 osqp==0.6.5
packaging 23.2 packaging==23.2
pandas 2.2.0 pandas==2.2.0
pandas-flavor 0.6.0 pandas-flavor==0.6.0
parso 0.8.3 parso==0.8.3
patsy 0.5.6 patsy==0.5.6
pillow 10.2.0 pillow==10.2.0
platformdirs 4.1.0 platformdirs==4.1.0
pluggy 1.5.0 pluggy==1.5.0
polars 1.9.0 polars==1.9.0
proglog 0.1.10 proglog==0.1.10
prompt-toolkit 3.0.43 prompt-toolkit==3.0.43
protobuf 4.25.4 protobuf==4.25.4
psutil 5.9.8 psutil==5.9.8
pure-eval 0.2.2 pure-eval==0.2.2
pyarrow 15.0.0 pyarrow==15.0.0
pyclipper 1.3.0.post5 pyclipper==1.3.0.post5
pycparser 2.22 pycparser==2.22
pycryptodomex 3.20.0 pycryptodomex==3.20.0
pydotplus 2.0.2 pydotplus==2.0.2
pydub 0.24.1 pydub==0.24.1
Pygments 2.17.2 Pygments==2.17.2
pyjanitor 0.26.0 pyjanitor==0.26.0
PyMuPDF 1.24.9 PyMuPDF==1.24.9
PyMuPDFb 1.24.9 PyMuPDFb==1.24.9
pyparsing 3.1.1 pyparsing==3.1.1
PyPDF2 3.0.1 PyPDF2==3.0.1
pyreadr 0.5.0 pyreadr==0.5.0
pytesseract 0.3.10 pytesseract==0.3.10
pytest 8.3.1 pytest==8.3.1
python-bidi 0.6.0 python-bidi==0.6.0
python-dateutil 2.8.2 python-dateutil==2.8.2
pytube 15.0.0 pytube==15.0.0
pytube3 9.6.4 pytube3==9.6.4
pytz 2023.3.post1 pytz==2023.3.post1
pywin32 306 pywin32==306
PyYAML 6.0.1 PyYAML==6.0.1
pyzmq 25.1.2 pyzmq==25.1.2
qdldl 0.1.7.post1 qdldl==0.1.7.post1
regex 2023.12.25 regex==2023.12.25
requests 2.32.3 requests==2.32.3
rich 13.7.1 rich==13.7.1
rpy2 3.5.16 rpy2==3.5.16
scikit-image 0.24.0 scikit-image==0.24.0
scikit-learn 1.3.2 scikit-learn==1.3.2
scikit-survival 0.22.2 scikit-survival==0.22.2
scipy 1.11.4 scipy==1.11.4
scs 3.2.6 scs==3.2.6
seaborn 0.13.2 seaborn==0.13.2
semantic-version 2.10.0 semantic-version==2.10.0
setuptools-rust 1.8.1 setuptools-rust==1.8.1
shapely 2.0.5 shapely==2.0.5
six 1.16.0 six==1.16.0
soupsieve 2.5 soupsieve==2.5
SpeechRecognition 3.10.1 SpeechRecognition==3.10.1
spyder-kernels 3.0.2 spyder-kernels==3.0.2
stack-data 0.6.3 stack-data==0.6.3
statsmodels 0.14.1 statsmodels==0.14.1
sympy 1.12 sympy==1.12
target 0.0.11 target==0.0.11
tensorboard 2.17.0 tensorboard==2.17.0
tensorboard-data-server 0.7.2 tensorboard-data-server==0.7.2
tensorflow 2.17.0 tensorflow==2.17.0
tensorflow-intel 2.17.0 tensorflow-intel==2.17.0
tensorflow-io-gcs-filesystem 0.31.0 tensorflow-io-gcs-filesystem==0.31.0
termcolor 2.4.0 termcolor==2.4.0
threadpoolctl 3.4.0 threadpoolctl==3.4.0
tifffile 2024.7.24 tifffile==2024.7.24
tiktoken 0.5.2 tiktoken==0.5.2
torch 2.4.0 torch==2.4.0
torchaudio 2.4.0 torchaudio==2.4.0
torchvision 0.19.0 torchvision==0.19.0
tornado 6.4 tornado==6.4
tqdm 4.66.1 tqdm==4.66.1
traitlets 5.14.1 traitlets==5.14.1
translator 0.0.9 translator==0.0.9
typing_extensions 4.9.0 typing_extensions==4.9.0
tzdata 2023.4 tzdata==2023.4
tzlocal 5.2 tzlocal==5.2
urllib3 2.1.0 urllib3==2.1.0
validators 0.33.0 validators==0.33.0
watchdog 3.0.0 watchdog==3.0.0
wcwidth 0.2.13 wcwidth==0.2.13
websockets 12.0 websockets==12.0
Werkzeug 3.0.3 Werkzeug==3.0.3
whisper 1.1.10 whisper==1.1.10
wrapt 1.16.0 wrapt==1.16.0
xarray 2024.1.1 xarray==2024.1.1
youtube-dl 2021.12.17 youtube-dl==2021.12.17
yt-dlp 2024.7.9 yt-dlp==2024.7.9

Tiempo que demora esta sección: 0 minutos